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1.0 INTRODUCTION 


The fig-FORTH implementation project occurred 
because a key group of Forth fanciers wished 
to make this valuable tool available on a 
personal computing level. In June of 1978, 
we gathered a team of nine systems level 
programmers, each with a particular target 
computer. The charter of the group was to 
translate a common model of Forth into assem¬ 
bly language listings for each computer. It 
was agreed that the group's work would be 
distributed in the public domain by FIG. This 
publication series is the conclusion of the 
work. 


2.0 DISTRIBUTION 


All publications of the Forth Interest Group 
are public domain. They may be further 
reproduced and distributed by inclusion 
of this credit notice; 

This publication has been made available 
by the Forth Interest Group, 

P. 0. Box 1105, San Carlos, Ca 94070 


We intend that our primary recipients of the 
Implementation Project be computer users 
groups, libraries, and commercial vendors. 

We expect that each will further customize for 
particular computers and redistribute. No 
restrictions are placed on cost, but we 

expect faithfulness to the model. FIG does 
not intend to distribute machine readable 
versions, as that entails customization, 
revision, and customer support better reserved 
for commerical vendors. 

Of course, another broad group of recipients 
of the work isthe community of personal 
computer users. We hope that our publications 
will aid in the use of Forth and increase 
the user expectation of the performance of 
high level computer languages. 


3.0 MODEL ORGINIZATION 


The fig-FORTH model deviates a bit from the 
usual loading method of Forth. Existing 
systems load about 2k bytes in object form 
and then self-compile the resident system 
(6 to 8 k bytes). This technique allows 
customization within the high level portion, 
but is impractical for new implementors. 

Our model has 4 to 5k bytes written as assem¬ 
bler listings. The remainder may be compiled 
typing in the Forth high-level source, by 
more assembly source, or by disc compilation. 
This method enhances transportability, 
although the larger portion in assembly code 
entails more effort. About 8k bytes of memory 
is used plus 2 to 8k for workspace. 

3.1 MODEL OVER-VIEW 

The model consists of 7 distinct areas. They 
occur sequentially from low memory to high. 

Boot-up parameters 
Machine code definitions 
High level utility definitions 
Installation dependent code 
High level definitions 
System tools (optional) 

RAM memory workspace 
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3.2 MODEL DETAILS 


Boot-up Parameters 

This area consists of 34 bytes containing a 
jump to the cold start, jump to the warm 
re-start and initial values for user variables 
and registers. These values are altered as 
you make permanent extensions to your 
installation. 


Machine Code Definitions 

This area consists of about 600 to 800 bytes 
of machine executable code in the form of 
Forth word deflntions. Its purpose is to 
convert your computer into a standard Forth 
stack computer. Above this code, the balance 
of Forth contains a pseudo-code compiled of 
”execution —addresses** which are sequences 
of the machine address of the "code-fields'* 
of other Forth definitions. All execution 
ultimately refers to the machine code 
definitions. 


High-level Utility Definitions 

These are colon—definitions, user variables, 
constants, and variables that allow you to 
control the "Forth stack computer". They 
comprise the bulk of the system, enabling 
you to execute and compile from the terminal. 
If disc storage (or a RAM simulation of disc) 
is available, you may also execute and compile 
from this facility. Changes in the high-level 
area are infrequent. They may be made thru 
the assembler source listings. 


Installation Dependent Code 

This area is the only portion that need 
change between different installations of the 
same computer cpu. There are four code 
f ragments: 

(KEY) Push the next ascii value (7 bits) 
from the terminal keystroke to the 
computation stack and execute NEXT. 

High 9 bits are zero. Do not echo this 
character, especially a control character. 


(EMIT) Pop the computation stack 
(16 bit value). Display the low 7 bits 
on the terminal device, then execute 
NEXT. Control characters have their 
natural functions. 

(?TERMINAL) For terminals with a break 
key, wait till released and push to 
the computation stack 0001 if it was 
found depressed; otherwise 0000. 

Execute NEXT. If no break key is avail 
able, sense any key depression as a 
break (sense but don't wait for a key). 
If both the above are unavailable, 
simply push 0000 and execute NEXT. 


(CR) Execute a terminal carriage 
return and line feed. Execute NEXT. 


When each of these words is executed, the 
intepreter vectors from the definition 
header to these code sequences. On 
specific implementations it may be necessary 
to preseve certain registers and observe 
operating system protocols. Understand the 
implementors methods in the listing before 
proceeding! 

R/W This colon-definition is the 
standard linkage to your disc. It 
requests the read or write of a disc 
sector. It usually requires supporting 
code definitions. It may consist of 
self-contained code or call ROM monitor 
code. When R/W is assembled, its code 
field address is inserted once in 
BLOCK and once in BUFFER. 

An alternate version of R/W is 
included that simulates disc storage 
in RAM. If you have over 16 k bytes 
this is practical for startup and 
limited operation with cassette. 


High-level Definitions 

The next section contains about 30 definit¬ 
ions involving user interaction: compiling 
aids, finding, forgetting, listing, and 
number formating. These definitions are 
placed above the installation dependent code 
to facilitate modification. That is, once 
your full system is up, you may FORGET part 
of the high-level and re-compile altered 
definitions from disc. 


Sytsem Tools 

A text editor and machine code assembler are 
normally resident. We are including a sample 
editor, and hope to provide Forth assemblers. 
The editor is compiled from the terminal 
the first time, and then used to place the 
editor and assembler source code on disc. 

It is essential that you regard the assembly 
listing as just a way to get Forth installed 
on your system. Additions and changes must 
be planned and tested at the usual Forth high 
level and then the assmbly routines updated. 
Forth work planned and executed only at an 
assembly level tends to be non-portable, and 
confusing. 

RAM Workspace 

For a single user system, at least 2k bytes 
must be available above the compiled system 
(the dictionary). A 16k byte total system 
is most typical. 

The RAM workspace contains the computation 
and return stacks, user area, terminal input 
buffer, di^c buffer and compilation space 
for the dictionary. 
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4.0 INSTALLATION 


We see the following methods of getting a 4-7 Execution errors may be localized by 

functioning fig-FORTH system: observing the above pointers when a crash 

occurs. 


1. Buy loadable object code from 
a vendor who has customized. 

2. Obtain an assembly listing with 
the installation dependent code 
supplied by the vendor. 

Assemble and execute. 

3. Edit the FIG assembly listing 
on your system, re-write the 
1^0 routines, and assemble. 

4. Load someone else's object code 
up to the installation dependent 
code. Hand assemble equivalents 
for your system and poke in with 
your monitor. Begin execution 
and type in (self-compile) the 
rest of the system. This takes 

dbout two hours once you under¬ 
stand the structure of Forth (but 
that will take much more time!). 


Let us examine Step 3, above, in fuller 
detail. If you wish to bring up Forth only 
from this model, here are the sequential 
steps: 

4.1 Familiarize yourself with the model 
written in Forth, the glossary, and specific 
assembly listings. 

4.2 Edit the assembly listings into your 
system. Set the boot-up parameters at origin 
offset OA, OB (bytes) to 0000 (warning«00). 

4.3 Alter the terminal support code 
(KEY, EMIT, etc,) to match your system. 

Observe register protocol specific to your 
implementation! 

4.4 Place a break to your monitor at the end 
of NEXT, just before indirectly jumping via 
register W to execution. W is the Forth name 
for the register holding a code field address, 
and may be differently referenced in your 
listings. 

4.5 Enter the cold start at the origin. Upon 
the break, check that the interpretive pointer 
IP points within ABORT and W points to SP ! . 

If COLD is a colon-definition, then the IP 
has been initialized on the way to NEXT and 
your testing will begin in COLD. The 
purpose of COLD is to initialize IP, SP, RP, 
UP, and some user variables from the start-up 
parameters atthe origin. 


4.6 Continue execution one word at a time. 
Clever individuaIs could write a simple trace 
routine to print IP, W, SP, RP and the topof 
the stacks. Run in this single step mode 
until the greeting message is printed. Note 
that the interpretation is several hundred 
cycles to this stage! 


4.8 After the word QUIT is executed 
(incrementally), and you can input a "return" 
key and get OK printed, remove the break. 

You may have some remaining errors, but a 
reset and examination of the above registers 
will again localize problems. 


4.9 When the system is interpreting from the 
keyboard, execute EMPTY-BUFFERS to clear 
the disc buffer area. You may test the disc 
access by typing: 0 BLOCK 64 TYPE 
This should bring sector zero from the disc 
to a buffer and type the first 64 characters. 
This sector usually contains ascii text of the 
disc directory. If BLOCK (and R/W) doesn't 
function--happy hunting! 

5.0 If your disc driver differs from the 
assembly version, you must create your own 
R/W. This word does a range check (with 
error message), modulo math to derive sector, 
track, and drive and passes values to a 
sector-read and sector-write routine. 

RAM DISC SIMULATION 

If disc is not available, a simulation of 
BLOCK and BUFFER may be made in RAM. The 
following definitions setup high memory as 
mass storage. Referenced 'screens' are then 
brought to the 'disc buffer' area. This is 
a good method to test the start-up program 
even if disc may be available. 

HEX 

4000 CONSTANT LO ( START OF BUFFER AREA ) 
6800 CONSTANT HI ( 10 SCREEN EQUIVALENT ) 

: R/W >R ( save boolean ) 

B/BUF * LO + DUP 

HI > 6 TERROR ( range check ) 

R> IF ( read ) SWAP ENDIF 

B/BUF CMOVE ; 

Insert the code field address of R/W into 
BLOCK and BUFFER and proceed as if testing 
disc. R/W simulates screens 0 thru 9 when 
B/BUF is 128, in the memory area $4000 thru 
$6BFF. 
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fig-FORTH VARIABLE NAME FIELD 

A major FIG innovation in this model, is 
the introduction of variable length defin¬ 
ition names in compiled dictionary entries* 
Previous methods only saved three letters and 
thecharactercount. 

The user may select the letter count saved, 
up to the full natural length. See the 
glossary definition for WIDTH. 

In this model, the following conventions 
have been established. 

1. The first byte of the name field has the 
natural character count in the low 5 bits* 
2o The sixth bit * 1 when smudged, and will 
prevent a match by (FIND). 

3. The seventh bit » 1 for IMMEDIATE defin¬ 
itions; it is called the precedence bit. 

4. The eighth or sign bit is always * 1. 

5. The following bytes contain the names' 

letters, up to the value in WIDTH. 

6. In the byte containing the last letter 

saved, the sign bit * I* 

7. In word addressing computer, a name may 

be padded with a blank to a word boundary. 


The above methods are implemented in CREATE. 
Remember that -FIND uses BL WORD to bring 
the next text to HERE with the count preceed- 
ing. All that is necessary, is to limit by 
WIDTH and toggle the proper delimiting bits. 

5.0 MEMORY MAP 

The following memory map is broadly used. 
Specific installations may require alterations 
but you may forfeit functions in future FIG 
off erings. 

The disc buffer area is at the upper bound of 
RAM memory. It is comprised of an integral 
number of buffers, each B/BUF+4 bytes. 

B/BUF is the number of bytes read from the 
disc, usually one sector. B/BUF must be a 
power of two (64, 128, 256, 512 or 1024). 

The constant FIRST has the value of the 
address of the start of the first buffer. 
LIMIT has the value of the first address 
beyond the top buffer. The distance between 
FIRST and LIMIT must be N*(B/BUF+4) bytes. 
This N must be two or more. 


Constant B/SCR has the value of the number of 
buffers per screen; i.e. 1024 / B/BUF. 

The user area must be at least 34 bytes; 48 
is more appropriate. In a multi-user system, 
each user has his own user area, for his copy 
of system variables. This method allows re¬ 
entrant use of the Forth vocabulary. 


The return stack grows downward from the user 
area toward the terminal buffer. Forty—eight 
bytes are sufficient. The origin is in RO 
(R-zero) and is loaded from a boot-up literal. 

The computation stack grows downward from the 
terminal buffer toward the dictionary, which 
grows upward. The origin of the stack is 
is in variable SO (S—zero) and is loaded from 
a boot-up literal. 

After a cold start, the user variables contain 
the addresses of the above memory assignments. 
An advanced user may relocate while the 
system is running. A newcomer should alter 
the startup literals and execute COLD. The 
word +0RIGIN is provided for this purpose* 
+0RIGIN gives the address byte or word rel¬ 
ative to the origin depending on the computer 
addressing method. To change the backspace 
to contol H type: 

HEX 08 OE +0RIGIN I ( byte addresses) 


6.0 DOCUMENTATION SUMMARY 

The following manuals are in print: 

Caltech FORTH Manual, an advanced manual with 
internal details of Forth. Has some implem¬ 
entation peculiarities. Approx. $6.50 from 
the Caltech Book Store, Pasadena, CA. 

Kitt Peak Forth Primer, $20.00 postpaid from 
the Forth Interest Group, P. 0. Box 1105, 

San Carlos, CA 94070. 

microFORTH Primer, $15.00 Forth, Inc. 

815 Manhattan Ave. Manhattan Beach, CA 90266 


Forth Dimensions, newsletter of the Forth 
Interest Group, $5.00 for 6 issues including 
membership. F.I.G. P.O. Box 1105, San Carlos, 
CA. 94070 


The terminal input buffer is decimal 80 bytes 
(the hex 50 in QUERY) plus 2 at the end. If a 
different value is desired, change the limit 
in QUERY. A parameter in the boot-up 
literals locates the address of this area for 
TIB. The backspace character is also in the 
boot-up origin parameters. It is universally 
expected that ’’rubout" is the backspace. 
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fig-FORTH GLOSSARY 


This glossary contains all of the worddef- 
initions in Release 1 of fig-FORTH. The 
definitions a re presented in the order of 
theirasciisort. 

The first line of each entry shows a symbolic 
description of the action of the proceedure on 
the parameter stack. The symbols indicate the 
order in which input parameters have been 
placed on the stack. Three dashes 
indicate the execution point; any parameters 
left on the stack are listed. In this 
notation, the top of the stack is to the 
right. 


The symbols include: 
addr memory address 

b 8 bit byte (i.e. hi 8 bits zero) 

c 7 bit ascii character (hi 9 bits zero) 

d 32 bit signed double integer^ 

most significant portion with sign 
on t op of s tack. 

f boolean flag. 0**false, non-zero*true 

f f b o olean false flag*0 

n 16 bit signed integer number 

u 16 bit unsigned integer 

tf boolean true flag*tton-zero 


The capital letters on the right show defin¬ 
ition characteristics: 

C May only be used within a colon defin¬ 

ition. A digit indicates number 
of memory addresses used, if other 
than one. 

E Intended for execution only. 

LO Level Zero definition of FORTH-78 
Ll Level One definition of FORTH-78 
P Has precedence bit set. Will execute 

even when compiling. 

U A user variable. 

Unless otherwise noted, all references to 
numbers are for 16 bit signed integers. On 
8 bit data bus computers, the high byte of 
a number is on top of the stack, with the sign 
in the leftmost bit. For 32 bit signed double 
numbers, the most significant part (with the 
sign) is on top. 

All arithemetic is implicitly 16 bit signed 
integer math, with error and under-flow 
indication unspecified. 
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!CSP 


// 


//> 


//s 


( 




( ;CODE) 


FORTH 


n addr - 

Store 16 bits of n at address. 
Pronounced "store”. 


(+LOOP) n - C2 

The run-time proceedure compiled 
by +LOOP, which Increments the loop 
index by n and tests for loop comple- 
tion. See +LOOP• 


Save the stack position in CSP. Used 
as part of the compiler security. 


dl d2 LO 

Generate from a double number dl, the 
next ascii character which is placed 
in an output string. Result d2 is 
the quotient after division by BASE, 
and is maintained for further pro¬ 
cessing. Used between <// and //>• 

See #S. 


(ABORT) 

Executes after an error when WARNING 
is -1. This word normally executes 
ABORT, but may be altered (with care) 
to a user's alternative proceedure. 


(DO) C 

The run-time proceedure compiled by 
DO which moves the loop control para¬ 
meters to the return stack. See DO. 


d -■— addr count LO 

Terminates numeric output conversion 
by dropping d, leaving the text 
address and character count suitable 
for TYPE. 


dl — d2 LO 

Generatesascii text in the text out¬ 
put buffer, by the use of //, until 
a zero double number n2 results. 

Used between <// and //>. 


--- addr P,L0 

Used in the form: 

nnnn 

Leaves the parameter field address 
of dictionary word nnnn. As a comp¬ 
iler directive, executes in a colon- 
definition to compile the address 
as a literal. If the word is not 
found after a search of CONTEXT and 
CURRENT, an appropriate error mess¬ 
age is given. Pronounced "tick". 


P,L0 


Used in the form: 

( cccc) 

Ignore a comment that will be 
delimited by a right parenthesis 
on the same line. May occur during 
execution or in a colon-definition. 

A blank after the leading parenthesis 
isrequired. 


(FIND) addrl addr2 — pfa b tf (ok) 

addrl addr2 - ff (bad) 

Searches the dictionary starting at 
the name field address addr2, match¬ 
ing to the text at addrl. Returns 
parameter field address, length 
byte of name field and boolean true 
for a good match. If no match is 
found, only a boolean false is left. 

(LINE) nl n2 --- addr count 

Convert the line number nl and the 
screen n2 to the disc buffer address 
containing the data. A count of 64 
indicates the full line text length. 

(LOOP) C2 

The run-time proceedure compiled by 
LOOP which increments the loop index 
and tests for loop completion. 

See LOOP. 


(NUMBER) dl addrl -— d2 addr2 

Convert the ascii text beginning at 
addrl+l with regard to BASE. The new 
value is accumulated into double 
number dl, being left as d2. Addr2 
isthe address of the first uncon- 
vertable digit. Used by NUMBER. 


nl n2 —prod LO 

Leave the signed product of two 
signed numbers. 


The run-time proceedure, compiled by 
." which transmits the following 
in-line text to the selected output 
device.See." 


The run-time proceedure, compiled by 
;CODE, that rewrites the code field 
of the most recently defined word to 
point to the following machine code 
sequence. See ;CODE. 


nl n2 n3 --- n4 LO 

Leave the ratio n4 * ni*n2/n3 
where all are signed numbers. Ret¬ 
ention of an intermediate 31 bit 
product permits greater accuracy than 
would be available with the sequence; 
n 1 n 2 * n 3 / 


nl n2 n3 - n4 n5 LO 

Leave the quotient rt5 and remainder 
n4 of the operation nl*n2/n3 
A 3rbit intermediate product is 
usedasfor*/. 
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+ 


+ 1 


+- 


+ BUF 


+LOOP 


+ORIGIN 


ni n2 — - sum -DUP 

Leave the sum of nl+n2. 


n addr -— 

Add n to the value at the address. 
Proaounced "plus-store". 


nl — nl (if zero) 

nl -- nl nl (non-zero) LO 

Reproduce nl only if it is non-zero. 
This is usually used to copy a value 
just before IF, to eliminate the need 
for an ELSE part to drop it. 


nl n2 - n3 

Apply the sign of n2 to nl* which 
is left as n3. 


addl — addr2 f 
Advance the disc buffer address addrl 
to the address of the next buffer 
addr2. Boolean f is false when addr2 
is the buffer presently pointed to 
by variable PREV. 


-find --- pfa b tf (found) 

- ff (not found) 

Accepts the next text word (delimited 
by blanks) in the input strean to 
HERE, and searches the CONTEXT and 
then CURRENT vocabularies for a 
matching entry. If found, the 
dictionary entry's parameter field 
address, its length byte, and a 
boolean true is left. Otherwise, 
only a boolean false is left. 


nl - (run) 

addr n2 —- (compile) P,C2,L0 
Used in a coIon—definition in the 
form: 

DO ... nl +L00P 
At run-time, +LOOP selectively 
controls branching back to the cor¬ 
responding DO based on nl, the loop 
index and the loop limit. The signed 
increment nl is added to the index 
and the total compared to the limit. 
The branch back to DO occurs until 
the new index is equal to or greater 
than the limit (nl>0), or until the 
new index is equal to or less than 
the limit (nl<0). Upon exiting the 
loof), the parameters are discarded 
and execution continues ahead. 


At compile time, +L00P compiles 
the run-time word (+L00P) and the 
branch offset computed from HERE to 
the address left on the stack by 
DO. n2 is used for compile time 
error checking. 


-TRAILING addr nl - addr n2 

Adjusts the character count nl of a 
text string beginning address to 
suppress the output of trailing 
blanks. i.e. the characters at 
addr+nl to addr+n2 are blanks. 

n — LO 

Print a number from a signed 16 bit 
two's complement value, converted 
according to the numeric BASE. 

A trailing blanks follows. 

Pronounced "dot". 


P,L0 


Used in the form: 

." cccc" 

Compiles an in-line string cccc 
(delimited by the trailing ") with an 
execution proceedure to transmit the 
text to the selected output device. 

If executed outside a definition, 
will immediately print the text until 
the final ". The maximum number of 
characters may be an installation 
dependent value. See (."). 


n ——— addr 

Leave the memory address relative 
by n to the origin parameter area, 
n is the minimum address unit, either 
byte or word. This definition is used 
to access or modify the boot-up 
parameters at the origin area. 


n — LO 

Store n into the next available dict¬ 
ionary memory cell, advancing the 
dictionary pointer. (comma) 

nl n2 - diff LO 

Leave the difference of nl-n2. 


P,L0 

Continue interpretation with the 
next disc screen, (pronounced 
next-screen). 


line scr —■“ 

Print on the terminal device, a line 
of text from the disc by its line and 
screen number. Trailing blanks are 
suppressed. 


nl n2 - 

Print the number nl right aligned in 
a field whose widthis n2. No 
following blank is printed. 


nl n2 - quot LO 

Leave the signed quotient of nl/n2. 


nl n2 - rem quot LO 

Leave the remainder and signed 
quotient of nl/n2. The remainder has 
the sign of the dividend. 


•.LINE 


.R 


/ 


/MOD 
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0 12 3 


P,L0 


n 

These small numbers are used so often 
that is is attractive to define them 
by name in the dictionary as const¬ 
ants. 


0< n - f LO 

Leave a true flag if the number is 
less than zero (negative), otherwise 
leaveafalseflag. 

0* n - f LO 

Leave a true flag is the number is 
equal to zero, otherwise leave a 
f alse flag. 


OBRANCH f - C2 

The run-time proceedure to condition¬ 
ally branch. If fis false (zero), 
the following in-line parameter is 
added to the interpretive pointer to 
branch ahead or back. Compiled by 
IF, UNTIL, and WHILE. 


1+ nl - n2 LI 

Increment nl by 1. 


2+ nl - n2 

Leave nl incremented by 2. 


P,E,L0 

Used in the form called a colon- 
definition: 

: cccc ... ; 

Creates a dictionary entry defining 
cccc as equivalent to the following 
sequence of Forth word definitions 

until the next or ';C0DE'. 

The compiling process is done by 
the text interpreter as long as 
STATE is non-zero. Other details 
are that the CONTEXT vocabulary is 
set to the CURRENT vocabulary and 
that words with the precedence bit 
set (P) are executed rather than 
being compiled. 


P,C,L0 

Terminate a colon-definition and 
stop further compilation. Compiles 
the run-time ;S. 


;s 

Stop interpretation of a screen. 

;S is also the run-time word compiled 
at the end of a colon-definition 
which returns execution to the 
calling proceedure. 


< nl n2 - f LO 

Leave a true flag if nl is less than 
n2; otherwise leave a false flag. 

<# LO 

Setup for pictured numeric output 
formatting using the words: 

<// // #S SIGN //> 

The conversion is done on a double 
number producing text at PAD. 

<BUILDS C,L0 

Used within a colon-definition: 

: cccc <BUILDS ... 

D0ES> ... ; 

Each time cccc is executed, <BUILDS 
defines a new word with a high-level 
execution proceedure. Executing cccc 
in the form: 

cccc nnnn 

uses <BUILDS to create a dictionary 
entry for nnnn with a call to the 
DOES> part for nnnn. When nnnn is 
later executed, it has the address of 
its parameter area on the stack and 
executes the words after DGES> in 
cccc. <BUILDS and D0ES> allow run¬ 
time proceedures to written in high- 
level rather than in assembler code 
(as required by ;C0DE). 


nl n2 —f LO 

Leave a true flag if nl*n2; other¬ 
wise leave a false flag. 


> nl n2 --- f LO 

Leave a true flag if nl Is greater 
than n2; otherwise a false flag. 

>R n -— C,L0 

Remove a number from the computation 
stack and place as the most access- 
able on the return stack. Use should 
be balanced with R> in the same 
definition. 


:gode p.c.lo 

Used in the form: 

: cccc .... ;CODE 

assembly mnemonics 

Stop compilation and terminate a new 
defining word cccc by compiling 
(;C0DE). Set the CONTEXT vocabulary 
to ASSEMBER, assembling to machine 
code the following mnemonics. 


addr — LO 

Print the value contained at the 
address in free format according to 
the current base. 


.7C0MP 

Issue error message if not compiling. 


When cccc later executes in the form: ?CSP 


cccc nnnn 

the word nnnn will be created with 
its execution proceedure given by 
by the machine code *fo1lowing cccc. 
That is, when nnnn is executed, it 
does so by Jumping to the code after 
nnnn. An existing defining word 
must exist in cccc prior to ;C0DE. 


Issue error message if stack position 
differs from value saved in CSP. 
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?ERROR 


B/B,UF 


f n 

Issue an error message number n, if 
the boolean flag is true. 

?EXEG 

Issue an error message if not exec¬ 
uting. 

7L0ADING 

Issue an error message if not loading 


?PAIRS nl n2 - 

Issue an error message if nl does not 
equal n2. The message indicates that 
compiled conditionals do not match. 


? STACK 

Issue an error message is the stack 
is out of bounds. This definition 
may be installation dependent. 


--- n 

This constant leaves the number of 
bytes per disc buffer, the byte count 
read from disc by BLOCK. 


B/SCR - n 

This constant leaves the number of 
blocks per editing screen. By con¬ 
vention, an editing screen is 1024 
bytes organized as 16 lines of 64 
characters each. 


BACK addr - 

Calculate the backward branch offset 
from HERE to addr and compile into 
the next available dictionary memory 
address. 


BASE - addr U,L0 

A user variable contaning the current 
number base used for input and out¬ 
put conversion. 


’TERMINAL --- f 



Perform a test of the terminal key¬ 
board for actuation of the break key. 

A true flag indicates actuation. 

BEGIN 


This definition is installation 
dependent. 


@ 

addr -— n LO 

Leave the 16 bit contents of address. 


ABORT 

LO 

Clear the stacks and enter the exec¬ 
ution state. Return control to the 
operators terminal, printing a mess¬ 
age appropriate to the installation. 


ABS 

n --- u LO 

Leave the absolute value of n as u. 

BL 

AGAIN 

addr n - (compiling) P,C2,L0 

Used in a colon-definion in the form: 
BEGIN ... AGAIN 



At run-time, AGAIN forces execution 
to return to corresponding BEGIN. 

There is no effect on the stack. 
Execution cannot leave this loop 
(unless R> DROP is executed one 

BLANKS 


level below)• 

At compile time, AGAIN compiles 

BRANCH with an offset from HERE to 
addr. n is used for compile-time 
error checking. 

BLK 


--- addr n (compiling) P,L0 
Occurs in a colon-definition in form: 
BEGIN ... UNTIL 
BEGIN ... AGAIN 
BEGIN ... WHILE ... REPEAT 
At run-time, BEGIN marks the start 
of a sequence that may be repetitive¬ 
ly executed. It serves as a return 
point from the correspoinding UNTIL, 
AGAIN or REPEAT. When executing 
UNTIL, a return to BEGIN will occur 
if the top of the stack is false; 
for AGAIN and REPEAT a return to 
BEGIN always occurs. 

At compile time BEGIN leaves its ret¬ 
urn address and n for compiler error 
checking. 


A constant that leaves the ascii 
value for "blank*** 


addr count - 

Fill an area of memory begining at 
addr with blanks. 


- addr U,L0 

A user variable containing the block 
number being interpreted. If zero, 
input is being taken from the term¬ 
inal input buffer. 


ALLOT n — LO 

Add the signed number to the diction¬ 
ary pointer DP. May be used to 
reserve dictionary space or re-origin 
memory. n is with regard to computer 
address type (byte or word). 

AND nl n2 --- n2 LO 

Leave the bitwise logical and of nl 
andn2asn3. 


BLOCK n —- addr LO 

Leave the memory address of the block 
buffer containing block n. If the 
block is not already in memory, it is 
transferred from disc to which ever 
buffer was least recently written. 

If the block occupying that buffer 
has been marked as updated, it is re¬ 
written to disc before block n is 
read into the buffer. See also 
BUFFER, R/W UPDATE FLUSH 
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COMPILE 


C2 


BLOCK-READ 

BLOCK-WRITE These are the preferred names 
for the installation dependent code 
to read and write one block to the 
disc. 


BRANCH C2,L0 

The run-time proceedure to uncondit¬ 
ionally branch. An in-line offset 
is added to the interpretive pointer 
IP to branch ahead or back. BRANCH 
is compiled by ELSE, AGAIN, REPEAT. 

BUFFER n - addr 

Obtain the next memory buffer, ass¬ 
igning it to block n. If the con¬ 
tents of the buffer is marked as up¬ 
dated, it is written to the disc 
The block is not read from the disc. 
The address left is the first cell 
within the buffer for data storage. 


When the word containing COMPILE 
executes, the execution address of 
the word following COMPILE is copied 
(compiled) into the dictionary. 

This allows specific compilation 
situations to be handled in additon 
to simply compling an execution 
address (which the interpreter 
already does ) . 

CONSTANT n - LO 

A defining word used in the form: 
n CONSTANT cccc 

to create word cccc, with its para¬ 
meter field containingn. When cccc 
is later executed, it will push 
the value of n to the stack. 


CONTEXT - addr U,L0 

A user variable containing a pointer 
to the vocabulary within which dict¬ 
ionary searches will first begin. 


C, 


C@ 


CFA 


CMOVE 


COLD 


b addr - COUNT 

Store 8 bits at address. On word 
addressing computers, further spec¬ 
ification is necessary regarding byte 
addressing. 

b — 

Store 8 bits of b into the next 
available dictionary byte, advancing 
the dictionary pointer. This is only CR 
available on byte addressing comp¬ 
uters, and should be used with 
caution on byte addressing mini¬ 
computers . 

CREATE 

addr --- b 

Leave the 8 bit contents of memory 
address. On word addressing comput¬ 
ers, further specification is needed 
regarding byte addressing. 

pf a --- cf a 

Convert the parameter field address 

of a definition to its code field CSP 

address. 


from to count --- 
Move the specified quantity of bytes 
beginning at address from to address D+ 
to. The contents of address from 
is moved first proceeding toward high 
memory. Further specification is 
necessary on word addressing comp¬ 
uters. D+- 


addrl - addr2 n LO 

Leave the byte address addr2 and byte 
count n of a message text beginning 
at address addrl. It is presumed 
that the first byte at addrl contains 
the text byte count and the actual 
text starts with the second byte. 
Typically COUNT is followed by TYPE. 


LO 

Transmit a carriage return and line 
feed to the selected output device. 


A defining word used in the form: 
CREATE cccc 

by such words as CODE and CONSTANT 
to create a dictionary header for 
a Forth definition. The code field 
contains the address of the words 
parameter field. The new word is 
created in the CURRENT vocablary. 

-- addr U 

A user variable temporarily storing 
the stack pointer position, for 
compilation error checking. 

dl d2 --- dsum 

Leave the double number sum of two 
double numbers. 

dl n - d2 

Apply the sign of n to the double 
number dl, leaving it as d2. 


The cold start proceedure to adjust 

the dictionary pointer to the min- D. 

Imum standard and restart via ABORT. 

May be called from the terminal to 
remove application programs and 
restart. 


d - LI 

Print a signed double number from a 
32 bit two's complement value. The 
high-order 16 bits are most access- 
able on the stack. Conversion is 
performed according to the current 
BASE. A blank follows. Pronounced 
D-dot. 
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D*R 

Print a signed double number d right 
aligned in a field n characters wide. 

DABS d - ud 

Leave the absolute value ud of a 
double number. 

DECIMAL LO 

Set the numeric conversion BASE for 
decimal input-output. 

DEFINITIONS LI 

Used in the form: 

cccc DEFINITIONS 
Set the CURRENT vocabulary to the 
CONTEXT vocabulary. In the example, 
executing vocabulary name cccc made 
it the CONTEXT vocabulary and exec¬ 
uting DEFINITIONS made both specify 
vocabulary cccc. 

DIGIT c nl - n2 tf (ok) 

c nl - f f (bad) 

Converts the ascii character c (using 
base nl) to its binary equivalent n2, 
accompanied by a true flag. If the 
conversion is invalid, leaves only 
a false flag• 


DLIST 

List the names of the dictionary 
entries in the CONTEXT vocabulary. 


DLITERAL d —- d (executing) 

d --- (compiling) P 

If compiling, corapile a s tack double 
number into a literal. Later execut¬ 
ion of the definition containing the 
literal will push it to the stack. If 
executing, the number will remain on 
the stack. 


DMINUS dl - d2 

Convert dl to its double number two's 
complement. 


DO nl n2 —(execute) 

addr n --- (compile) P,C2,L0 

Occurs in a colon-definition in form: 

DO ... LOOP 

DO ... +LOOP 

At run time, DO begins a sequence 
with repetitive execution controlled 
by a loop limit nl and an index with 
initial value n2. DO removes these 
from the stack. Upon reaching LOOP 
the index is incremented by one. 

Until the new index equals or exceeds 
the limit, execution loops back to 
just after DO; otherwise the loop 
parameters are discarded and execut¬ 
ion continues ahead. Both nl and n2 
are determined at run-time and may be 
the result of other operations. 

Within a loop 'I' will copy the 

urrent value of the index to the 
stack. See I, LOOP, +LOOP, LEAVE. 

When compiling within the colon- 
definition, DO compiles (DO), leaves 
the following address addr and n for 
later error checking. 

DOES> LO 

A word which defines the run-time 
action within a high-level defining 
word. DOES> alters the code field 
and first parameter of the new word 
to execute the sequence of compiled 
word addresses following DOES>. Used 
in combination with<BUILDS. When the 
DOES> part executes it begins with 
the address of the first parameter 
of the new word on the stack. This 
allows interpretation using this 
area or its contents. Typical uses 
include the Forth assembler, multi- 
diminsional arrays, and compiler 
generation. 


DP - addr U,L 

A user variable, the dictionary 
pointer, which contains the address 
of the next free memory above the 
dictionary. The value may be read by 
HERE and altered by ALLOT. 


DPL - addr U,L0 

A user variable containing the number 
of digits to the right of the decimal 
on double integer input. It may also 
be used hold output column location 
of a decimal point, in user generated 
formating. The default value on 
single number input is -1. 


DRO Installation dependent commands to 

DRl select disc drives, by preseting 

OFFSET.The contents of OFFSET is 
added to the block number in BLOCK 
to allow for this selection. Offset 
issupressed for errortext so that 
is may always originate from drive 0. 
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DROP n - LO 

Drop the number from the stack. 

DUMP addr n --- LO 

Print the contents of n memory 
locations beginning at addr. Both 
addresses and contents are shown in 
the current numeric base. 


DUP n --- n n LO 

Duplicate the value on the stack. 


ELSE addri nl --- addr2 n2 

(compiling) P,C2,L0 
Occurs within a colon-definition 
in the form: 

IF ... ELSE ... ENDIF 
At run-time, ELSE executes after the 
true part following IF. ELSE forces 
execution to skip over the following 
false part and resumes execution 
after the ENDIF. It has no stack 
effect. 

At compile-time ELSE emplaces BRANCH 
reserving a branch offset, leaves 
the address addr2 and n2 for error 
testing. ELSE also resolves the 
pending forward branch from IF by 
calculating the offset from addri to 
HERE and storing at addri. 


EMIT c - LO 

Transmit ascii character c to the 
selected output device. OUT is 
incremented for each character 
output. 


EMPTY-BUFFERS LO 

Mark all block-buffers as empty, not 
necessarily affecting the contents. 
Updated blocks arenotwritten to the 
disc. This is also an initialization 
proceedure before first use of the 
disc. 

ENCLOSE addri c - 

Cdr1 n1 n2 n3 

The text scanning primitive used by 
WORD. From the text address addri 
and an ascii delimiting character c, 
is determined the byte offset to the 
first non-delimiter character nl, 
the offset to the first delimiter 
after the text n2, and the offset 
to the first character not included. 
This proceedure will not process past 
an ascii 'null^, treating it as an 
unconditional delimiter. 


end P,C2,L0 

This is an 'alias" or duplicate 
definition for UNTIL. 


ENDIF addr n - (compile) P,C0,L0 

Occurs in a colon-definition in form: 
IF ... ENDIF 
IF ... ELSE ... ENDIF 
At run-time, ENDIF serves only as the 
destination of a forward branch from 
IF or ELSE. It marks the conclusion 
of the conditional structure. THEN 
is another name for ENDIF. Both 
names are supported In fig-FORTH. See 
also IF and ELSE. 

At compile-time, ENDIF computes the 
forward branch offset from addr to 
HERE and stores it at addr. n is 
used for error tests. 


ERASE addr n -— 

Clear a region of memory to zero from 
addr over n addresses. 

ERROR line — in blk 

Execute error notification and re¬ 
start of system. WARNING is first 
examined. If 1, the text of line n, 
relative to screen 4 of drive 0 is 
printed. This line number may be 
positive or negative, and beyond just 
screen 4. If WARNING^O, n is just 
printed as a message number (non disc 
installation). If WARNING is -1, 
the definition (ABORT) is executed, 
which executes the system ABORT. The 
user may cautiously modify this 
execution by altering (ABORT). 
fig-FORTH saves the contents of IK 
and BLK to assist in determining the 
location of the error. Final action 
is execution of QUIT. 


EXECUTE addr — 

Execute the definition whose code 
field address is on the stack. The 
code field address is also called 
the compilation address. 


EXPECT addr count - LO 

Transfer characters from the terminal 
to address, until a '^return" or the 
count of characters have been rec¬ 
eived. One or more nulls are added 
at the end of the text. 


FENCE - addr U 

A user variable containing an 
address below which FORGETting is 
trapped. To forget below this point 
the user must alter the contents of 
FENCE. 


FILL addr quan b -— 

Fill memory at the address with the 
specified quantlty ofbytesb. 


FIRST - n 

A constant that leaves the address 
of the first (lowest) block buffer. 
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FLD 


FORGET 


FORTH 


HERE 


HEX 


HLD 


HOLD 


I 


ID. 


FORTH 


--- addr U IF 

A user variable for control of number 
output field width. Presently un¬ 
used in fig-FORTH. 


E,L0 

Executed in the form: 

FORGET cccc 

Deletes definition named cccc from 
the dictionary with all entries 
physically following it. In fig- 
FORTH, an error message will occur if 
the CURRENT and CONTEXT vocabularies 
are not currently the same. 


P,L1 

The name of the primary vocabulary. 
Execution makes FORTH the CONTEXT 
vocabulary. Until additional user 
vocabularies are defined, new user 
definitions become a part of FORTH. 
FORTH is immediate, so it will exec¬ 
ute during the creation of a colon- 
definition, to select this vocabulary 
at compile time. 


--- addr LO 

Leave the address of the next avail¬ 
able dictionary location. 

LO 

Set the numeric conversion base to 
sixteen (hexadecimal). 


- addr LO 

A user variable that holds the addr- IN 
ess of the latest character of text 
during numeric output conversion. 


c -— LO 

Used between <// and //> to insert 
an ascii character into a pictured 
numeric output string, 
e.g. 2E HOLD will place a 
decimal point. 


— - n C ,L0 

Used within a DO—LOOP to copy the 
loop index to the stack. Other 
use is implementation dependent. 

S e e R. 

addr --- 

Print a definition's name from its 
name field address. 


- (run-time) 

addr n (compile) P,C2,L0 
Occurs is a colon-definition in form: 
IF (tp) ... ENDIF 
IF (tp) ... ELSE (fp) ... ENDIF 
At run-time, IF selects execution 
based on a boolean flag. If f is 
true (non-zero), execution continues 
ahead thru the true part. If f is 
false (zero), execution skips till 
just after ELSE to execute the false 
part. After either part, execution 
resumes after ENDIF. ELSE and its 
false part are optional.; if missing, 
false execution skips to just after 
ENDIF. 

At compile-time IF compiles OBRANCH 
and reserves space for an offset 
at addr. addr and n are used later 
for resolution of the offset and 
error testing. 

IMMEDIATE 

Mark the most resently made definit¬ 
ion so that when encountered at 
compile time, it will be executed 
rather than being compiled, i.e. the 
precedence bit in its header is set. 
This method allows definitions to 
handle unusual compiling situations, 
rather than build them into the 
fundamental compiler. The user may 
force compilation of an immediate 
definition by preceeding it with 
[COMPILE]. 


•- addr LO 

A user variable containing the byte 
offset within the current input text 
buffer (terminal or disc) from which 
the next text will be accepted. WORD 
uses and moves the value of IN. 


INDEX from to --- 

Print the first line of each screen 
over the range from, to. This is 
used to view the comment lines of an 
area of text on disc screens. 


INTERPRET 

The outer text interpreter which 
sequentially executes or compiles 
text from the input stream (terminal 
or disc) depending on STATE. If the 
word name cannot be found after 
a search of CONTEXT and then CURRENT 
it is converted to a number according 
to the current base. That also fall¬ 
ing, an error message echoing the 
name with a '* ?" will be given. 

Text input will be taken according to 
the convention for WORD. If a decimal 
point is found as part of a number, 
a double number value will be left. 
The decimal point has no other pur¬ 
pose than to force this action. 

See NUMBER. 
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KEY 


LATEST 


LEAVE 


LFA 


LIMIT 


LIST 


LIT 


LITERAL 


LOAD 


FORTH 


- c LO LOOP 

Leave the ascii value of the next 
terminal key struck. 


- ad dr 

Leave the name field address of the 
topmost word in the CURRENT vocabul¬ 
ary. 


C,L0 

Force termination of a DO-LOOP at the 
next opportunity by setting the loop 
limit equal to the current value of 
the index. The index itself remains 
unchanged, and execution prodeeds 
normally until LOOP or +LOOP is 
encountered. 


pfa - If a 

Convert the parameter field address 
of a dictionary definition to its 
link field address. 


A constant leaving the address just 
above the highest memory available 
for a disc buffer. Usually this is 
the highest system memory. 


addr n --- (compiling) P,C2,L0 

Occurs in a colon-definition in form: 
DO ... LOOP 

At run-time, LOOP selectively cont¬ 

rols branching back to the correspon¬ 
ding DO based onthe loop index and 
limit. The loop index is incremented 
by one and compared to the limit. The 
branch back to DO occurs until the 
index equals or exceeds the limit; 
at that time, the parameters are 
discarded and execution continues 
ahead. 

At compile-time, LOOP compiles (LOOP) 
and uses addr to calculate an offset 
to DO. n is used for error testing. 

M* nl n2 - d 

A mixed magnitude math operation 
which leaves the double number signed 
product of two signed number. 

M/ d nl - n2 n3 

A mixed magnitude math operator which 
leaves the signed remainder n2 and 
signed quotient n3, from a double 
number dividend and divisor nl. The 
remainder takes its sign from the 
dividend. 


n —- LO M/MOD 

Display the ascii text of screen n 
on the selected output device. SCR 
contains the screen number during and 
after this process. 


ud 1 u2 —u3 ud 4 
An unsigned mixed magnitude math 
operation which leaves a double 
quotient ud4 and remainder u3, from 
a double dividend ud1 and single 
divisor u2. 


- n C2,L0 

Within a colon-definition, LIT is 
automatically compiled before each 
16 bit literal number encountered in 
input text. Later execution of LIT 
causes the contents of the next 
dictionary address to be pushed to 
the s tack. 


n —- (compiling) P,C2,L0 

If compiling, then compile the stack 
value n as a 16 bit literal. This 
definition is immediate so that it 
will execute during a colon defin¬ 
ition. The intended use is: 

: XXX [calculate ] LITERAL ; 
Compilation is suspended for the 
compile time calculation of a value. 
Compilation is reusumed and LITERAL 
compiles this value. 


n - LO 

Begin interpretation of screen n. 
Loading will terminate at the end of 
the screen or at ;S. See ;S and -->. 


MAX nl n2 --- max LO 

Leave the greater of two numbers. 

MESSAGE n - 

Print on the selected output device 
the text of line n relative toscreen 
4 of drive 0. n may be positive or 
negative. MESSAGE may be used to 
print incidental text such as report 
headers. If WARNING is zero, the 
message will simply be printed as 
a number (disc un-available) . 

MIN nl n2 --- min LO 

Leave the smaller of two numbers. 

MINUS nl — n2 LO 

Leave the two's complement of a 
number. 


MOD nl n2 --- mod LO 

Leave the remainder of nl/n2, with 
the same sign as nl. 


MON 

Exit to the system monitor, leaving 
a re-entry to Forth, if possible. 
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MOVE addrl addr2 n — 

Move the contents of n memory cells 
(16 bit contents) beginning at addrl 
into n cells beginning at addr2. 

The contents of addrl is moved first* 
This definition is appropriate on 
on word addressing computers* 


NEXT 

this is the inner interpreter that 
uses the interpretive pointer IP to 
execute compiled Forth definitions* 
It is not directly executed but is 
the return point for all code pro- 
ceedures* It acts by fetching the 
address pointed by IP, storing this 
value in register W. It then jumps 
to the address pointed to by the 
address pointed to by W. W points to 
the code field of a definition which 
contains the address of the code 
which executes for that definition. 
This usage of indirect threaded code 
is a major contributor to the power, 
portability, and extensibility of 
Forth* Locations of IP and W are 
computer specific* 


NFA pfa —- nfa 

Convert the parameter field address 
of ,a definition to its name field. 


NUMBER addr - d 

Convert a character string left at 
addr with a preceeding count, to 
a signed double number, using the 
current numeric base. If a decimal 
point is encountered in the text, its 
position will be given in DPL, but 
no other effect occurs* If numeric 
conversion is not possible, an error 
message will be given* 


OFFSET - addr U 

A user variable which may contain 
ablock offset to disc drives. The 
contents of OFFSET is added to the 
stack number by BLOCK. Messages 
byMESSAGE are independent of OFFSET. 
See BLOCK, DRO, DRl, MESSAGE. 


OR nl n2 -- or LO 

Leave the bit-wise logical or of two 
16 bit values* 


OUT —- addr U 

A user variable that contains a value 
incremented by EMIT* The user may 
alter and examine OUT to control 
display formating. 


OVER ni n2 -— nl n2 nl LO 

Copy ,the second stack value, placing 
it as the new top. 


PAD - addr LO 

Leave the address of the text output 
buffer, which is a fixed offset above 
HERE. 


PFA nf a -— pfa 

Convert the name field address of 
a compiled definition to its para¬ 
meter field address. 


POP 

The code sequence to remove a stack 
value and return to NEXT. POP is 
not directly executable, but is a 
Forth re-entry point after machine 
code* 


PREV -- addr 

A variable containing the address of 
the disc buffer most recently ref¬ 
erenced. The UPDATE command marks 
this buffer to be later written to 
disc. 


PUSH 

This code sequence pushes machine 
registers to the computation stack 
and returns to NEXT. It is not 
directly executable, but is a Forth 
re-entry point after machine code* 


PUT 

This code sequence stores machine 
register contents over the topmost 
computation stack value and returns 
to NEXT* It is not directly exec¬ 
utable, but is a Forth re-entry point 
after machine code. 


QUERY 

Input 80 characters of text (or until 
a "return”) from the operators 
terminal. Text is positioned at the 
address contained in TIB with IN 
set to zero. 


QUIT LI 

Clear the return stack, stop compil¬ 
ation, and return control to the 
operators terminal. No message 
is given. 


R - n 

Copy the top of the return stack to 
the computation stack. 

R// - addr U 

A user variable which may contain 
the location of an editing cursor, 
or other file related function. 
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SMUDGE 


R/W 


R> 


RO 


REPEAT 


ROT 


RP 1 


S->D 


SO 


SCR 


SIGN 


FORTH 


addr blk f - 

The fig-FORTH standard disc read- 
write linkage. addr specifies the 
source or destinationblock buffer, 
blk is the sequential number of 
the referenced block; and f is a 
flag for f*0 write and f*l read. 

R/W determines the location on mass 
storage, performs the read-write and 
performs any error checking. 

- n LO 

Remove the top value from the return 
stack and leave it on the computation 
stack. See >R and R. 


— addr U 

A user variable containing the 
initial location of the return stack. 
Pronounced R-zero. See RP! 

addr n --- (compiling) P,C2 
Used within a colon-definition in the 
form: 

BEGIN ... WHILE ... REPEAT 
At run-time, REPEAT forces an 
unconditional branch back to just 
after the correspoinding BEGIN. 

At compile-time, REPEAT compiles 
BRANCH and the offset from HERE to 
addr. n is used for error testing. 

nl n2 n3 -— n2 n3 nl LO 
Rotate the top three values on the 
stack, bringing the third to the top. 


A computer dependent proceedure to 
initialize the return stack pointer 
from user variable RO. 


n - d 

Sign extend a single number to form 
a double number. 


--- addr U 

A user variable that contains the 
initial value for the stack pointer. 
Pronounced S-zero. See SPI 


— addr U 

A user variable containing the screen 
number most recently reference by 
LIST. 


n d --- d LO 

Stores an ascii sign justbefore 

a converted numeric output string 
in the text output buffer when n is 
negative. n is discarded, but double 
number d is maintained. Must be 
used between and ^>. 


Used during word definition to toggle 
the ’’smudge bit” in a definitions' 
name field. This prevents an un¬ 
completed definition from being found 
during dictionary searches, until 
compiling is completed without error. 


SPi 

A computer dependent proceedure to 
initialize the stack pointer from 
SO. 


SP@ --- addr 

A computer dependent pi[oceed,ure to 
return the address of the stack 
position to the top of the stack, 
as it was before SP@ was executed, 
(e.g. i 2 SP@ @ • . . would 

type 2 2 1) 


SPACE LO 

Transmit an ascii blank to the output 
device. 


SPACES n ——— LO 

Transmit n ascii blanks to the output 
device. 


STATE —- addr L0,U 

A user variable containg the compil¬ 
ation state. A non-zero value 
indicates compilation. The value 
itself may be implementation depend¬ 
ent. 


SWAP nl n2 -— n2 nl LO 

Exchange the top two values on the 
s tack. 


TASK 

A no-operation word which can mark 
the boundary between applications. 

By forgetting TASK and re-compiling, 
an application can be discarded in 
its entirety. 


then P,G0,L0 

An alias for ENDIF. 


TIB -— addr U 

A user variable containing the addr¬ 
ess of the terminal input buffer. 


TOGGLE addr b ——— 

Complement the contents of addr by 
the bit pattern b. 


TRAVERSE addrl n —-p- addr2 

Move across the name field of a 
fig-FORTH variable length name field, 
addrl is the address of either the 
length byte or the last letter. 

If n*l, the motion is toward hi mem¬ 
ory; if n*-l, the motion is toward 
low memory. The addr2 resulting is 
address of the other end of the name* 
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VARIABLE 


TRIAD 


TYPE 


U* 


U/ 


UNTIL 


UPDATE 


USE 


USER 


FORTH 


scr —- 

Display on the selected output device 
the three screens which include that 
numbered scr, begining with a screen 
evenly divisible by three- Output 
is suitable for source text records, 
and includesa reference line at the 
bottom taken from line 15 of screen4. 


E,LU 

A defining word used in the form: 
n VARIABLE cccc 

When VARIABLE is executed, it creates 
the definition cccc with its para¬ 
meter field initialized to n. When 
cccc is later executed, the address 
of its parameter field (containing n) 
is left on the stack, so that a fetch 
or store may access this location- 


addr count —- LO 

Transmit count characters from addr 
to the selected output device. 

ul u2 —- ud 

Leave the unsigned double number 
product of two unsigned numbers. 


VOC-LINK - addr U 

A user variable containing the addr¬ 
ess of a field in the definition of 
the most recently created vocabulary. 
All vocabulary names are linked by 
these fields to allow control for 
FORGETting thru multiple vocabularys. 


ud u1 --- u2 u3 

Leave the unsigned remainder u2 and 
unsigned quotient u3 from the unsign¬ 
ed double dividend ud and unsigned 
divisor ul • 


f (run-time) 

addr n --- (compile) P,C2,L0 
Occurs within a colon-definition in 
the form: 

BEGIN ... UNTIL 

At run-time, UNTIL controls the cond¬ 
itional branch back to the corres¬ 
ponding BEGIN. If f is false, exec¬ 
ution returns to just after BEGIN; 
if true, execution continues ahead. 

At compile-time, UNTIL compiles 
(OBRANCH) and an offset from HERE 
to addr. n is used for error tests. 


LO 

Marks the most recently referenced 
block (pointed to by PREV) as 
altered. The block will subsequently 
be transferred automatically to disc 
should its buffer be required for 
storage of a different block. 


--- addr 

A variable containing the address of 
the block buffer to use next, as the 
least recently written. 


VOCABULARY E,L 

A defining word used in the form; 

VOCABULARY cccc 

to create a vocabulary definition 
cccc- Subsequent use of cccc will 
make it the CONTEXT vocabulary which 
is searched first by INTERPRET. The 
sequence 'Vcccc DEFINITIONS" will 
also make cccc the CURRENT vocabulary 
into which new definitions are 
placed. 

In fig-FORTH, cccc will be so chained 
as to include all definitions of the 
vocabulary in which cccc is itself 
defined. All vocabularys ulitmately 
chain to Forth- By convention, 
vocabulary names are to be declared 
IMMEDIATE. See VOC-LINK. 


VLIST 

List the names of the definitions in 
the context vocabulary. "Break” will 
terminate the listing. 


WARNING - addr U 

A user variable containing a value 
controlling messages. If * 1 
disc is present, and screen 4 of 
driVe 0 is the base location for 
messages. If =* 0, no disc is present 
and messages will be presented by 
number. If * -I, execute (ABORT) for 
a user specified proceedure. 

See MESSAGE, ERROR. 


n - LO WHILE 

A defining word used in the form: 
n USER cccc 

which creates a user variable cccc. 

The parameter field of cccc contains 
n as a fixed offset relative to 
the user pointerregister UP for 
this user variable. When cccc is 
later executed, it places the sum of 
its offset and the user area base 
address on the stack as the storage 
address of that particular variable. 


INTEREST GROUP .RO. Box 


f --- (run-time) 

adl nl - adl nl ad2 n2 P,C2 

Occurs in a colon-definition in the 
form: 

BEGIN ... WHILE (tp) ... REPEAT 
At run-time, WHILE selects condition¬ 
al execution based on boolean flag f. 

If f is true (non-zero), WHILE cont- 
intues execution of the true part 
thru to REPEAT, which then branches 
back to BEGIN. If f Is false (zero), 
execution skips to just after REPEAT, 
exiting the structure. 

At compile time, WHILE emplaces 
(OBRANCH) and leaves ad2 of the res¬ 
erved offset. The stack values will 
be resolved by REPEAT. 

1105 . San Carlos, Ca. 94070 yj 




WIDTH 


WORD 


X 


XOR 


E 


fCOMPILE] 


\ 


addr ' U 

In fig-FORTH, a user variable cont¬ 
aining the maximum number of letters 
saved in the compilation of a 
definitions'' name. It must be 1 thru 
31, with a default value of 31. The 
name character count and its natural 
characters are saved, up to the 
value in WIDTH. The value may be 
changed at any time within the above 
limits. 


c --- LO 

Read the next text characters from 
the input stream being interpreted, 
until a delimiter c is found, storing 
the packed character string begining 
at the dictionary buffer HERE. WORD 
leaves the character count in the 
first byte, the characters, and ends 
with two or more blanks. Leading 
oGcurances of c are ignored. If BLK 
is zero, text is taken from the 
terminal input buffer, otherwise from 
the disc block stored in BLK. 

See BLK, IN. 


This is pseudonym for the "null" 
or dictionary entry for a name of 
one character of ascii null. It 
is the execution proceedure to term¬ 
inate interpretation of a line of 
text from the terminal or within 
a disc buffer, as both buffers always 
have a null at the end. 


nl n2 --— xor LI 

Leave the bitwise logical exclusive- 
or of two values. 


P,L1 

Used in a colon-definition in form: 

: XXX [ words ] more ; 
Suspend compilation. The words after 
[ are executed, not compiled. This 
allows calculation or compilation 
exceptions before resuming compil¬ 
ation with ]. See LITERAL, ]. 


P,C 

Used in a colon-definition in form; 

; XXX [COMPILE] FORTH ; 
[COMPILE] will force the compilation 
of an immediate defininition, 
that would otherwise execute 
during compilation. The above 
example will select the FORTH 
vocabulary when xxx executes, rather 
than at compile time. 


hi 

Resume compilation, to the completion 
of a colon-definition. See [. 
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SCR // 3 

0 ********************** fig-FORTH MODEL ********************** 
.1 

2 Through the courtesy of 

3 ■ 

4 FORTH INTEREST GROUP 

5 P. 0. BOX 1105 

6 SAN CARLOS, CA. 94070 


RELEASE 1 

WITH COMPILER SECURITY . 
AND 

VARIABLE LENGTH NAMES 


Further distribution must include the above notice. 


SCR # 4 

0 ( ERROR MESSAGES ) 

1 EMPTY STACK 

2 DICTIONARY FULL 

3 HAS INCORRECT ADDRESS MODE 

4 ISN'T UNIQUE 

5 

6 DISC RANGE ? 

7 FULL STACK 

8 DISC ERROR ! 

9 

10 
11 
12 
13 
I A 

15 FORTH INTEREST GROUP MAY 1, 1979 


SCR # 5 

0 ( ERROR MESSAGES ) 

1 COMPILATION ONLY, USE IN DEFINITION 

2 EXECUTION ONLY 

3 CONDITIONALS NOT PAIRED 

4 DEFINITON NOT FINISHED 

5 IN PROTECTED DICTIONARY 

6 USE ONLY WHEN LOADING 

7 OFF CURRENT EDITING SCREEN 

8 DECLARE VOCABULARY 

9 

10 
11 
12 
1 3 

14 

15 
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CODE 

LIT 

( PUSH FOLLOWING 

LITERAL TO 

STACK 

*) 

1 

13 

LABEL 

PUSH 

( PUSH ACCUM AS HI- 

BYTE, ML 

STACK AS LO 

-BYTE 

*) 

4 

13 

L ABEL 

PUT 

( REPLACE BOTTOM 

WITH ACCUM. AND ML 

STACK 

*) 

6 

13 

LABEL 

NEXT 

( EXECUTE NEXT 

FORTH ADDRESS, MOVING IP 

*) 

8 

13 

HERE 

<CLIT> 

1 HERE 24- , 

( 

MAKE SILENT 

WORD 

*) 

1 

14 

LABEL 

SETUP ( 

MOVE # ITEMS FROM STACK TO ' 

N' AREA OF Z 

-PAGE 

*) 

4 

14 

CODE 

EXECUTE 

( EXECUTE 

A WORD 

BY ITS CODE 

FIELD 

*) 

9 

14 




( ADDRESS ON THE 

STACK 

*) 

10 

14 


CODE 

CODE 

CODE 

CODE 

CODE 

CODE 

CODE 


CODE 

CODE 

( 

CODE 

CODE 

CODE 

CODE 

CODE 

CODE 


BRANCH 

OBRANCH 

(LOOP) 

(+LOOP) 

(DO) 

I 

DIGIT 


( ADJUST IP BY IN-LINE 16 BIT LITERAL 
(IF BOT IS ZERO, BRANCH FROM LITERAL 
( INCREMENT LOOP INDEX, LOOP UNTIL => LIMIT 
(INCREMENT INDEX BY STACK VALUE +/- 
( MOVE TWO STACK ITEMS TO RETURN STACK 
( COPY CURRENT LOOP INDEX TO STACK 
CONVERT ASCII CHAR-SECOND, WITH BASE-BOTTOM 
( IF OK RETURN DIGIT-SECOND, TRUE-BOTTOM; 

( OTHERWISE FALSE-BOTTOM. 


(FIND) 
ENCLOSE 
ADDR-4, 
EMIT 
KEY 

7TERMINAL 

CR 

CMOVE 
U* 


( HERE, 

( 

AND 


CODE U/ 


CODE 

CODE 

CODE 

CODE 

CODE 

CODE 

CODE 

CODE 


XSAVE 
lODE >R 


AND 
OR 
XO R 
SP@ 

SP! 

RP ! 

; s 

LEAVE 

STX, 


FROM-3, TO-2, QUAN-1 

*) 

1 

22 

16 BIT MULTIPLIER-1 

*) 

1 

23 

LO WORD-2, HI WORD-1 

*) 

2 

23 

, 16 BIT DIVISOR-1 

*) 

1 

24 

16 BIT QUOTIENT-1 

*) 

2 

24 

OF BOTTOM TWO ITEMS 

*) 

2 

2 5 

OF BOTTOM TWO ITEMS 

*) 

6 

25 


C 

CODE 

CODE 


R> 

R 

CODE 0= 

CODE 0< 

CODE + 

CODE D+ 

CODE MINUS 
CODE DMINUS 
CODE OVER 
lODE DROP 
CODE SWAP 
CODE DUP 
CODE +! ( 

CODE TOGGLE 
CODE @ 

BOT X) 
CODE C@ 

CODE i 


NFA ... PFA, LEN BYTE, TRUE; ELSE FALSE 
ENTER WITH ADDRESS-2, DELIM-1. RETURN WITH 
OFFSET TO FIRST CH-3, END WORD-2, NEXT CH-1 
(PRINT ASCII VALUE ON BOTTOM OF STACK 
(ACCEPT ONE TERMINAL CHARACTER TO THE STACK 
( 'BREAK' LEAVES 1 ON STACK; OTHERWISE 0 
( EXECUTE CAR. RETURN, LINE FEED ON TERMINAL 
WITHIN MEMORY; ENTER W/ 

( 16 BIT MULTIPLICAND-2, 

32 BIT UNSIGNED PRODUCT: 

( 31 BIT DIVIDEND-2, -3 
( 16 BIT REMAINDER-2, 

( LOGICAL BITWISE AND 
( LOGICAL BITWISE 'OR' 

( LOGICAL 'EXCLUSIVE-OR' OF BOTTOM TWO ITEMS 
( FETCH STACK POINTER TO STACK 
( LOAD SP FROM 'SO' 
( LOAD RP FROM RO 
( RESTORE IP REGISTER FROM RETURN STACK 
( FORCE EXIT OF DO-LOOP BY SETTING LIMIT 
TSX, R LDA, R 24- STA, ( TO INDEX 

( MOVE FROM COMP. STACK TO RETURN STACK 
(MOVE FROM RETURN STACK TO COMP. STACK 
(COPY THE BOTTOM OF RETURN STACK TO COMP. STACK 
(REVERSE LOGICAL STATE OF BOTTOM OF STACK 
( LEAVE TRUE IF NEGATIVE; OTHERWISE FALSE 
( LEAVE THE SUM OF THE BOTTOM TWO STACK ITEMS 
( ADD TWO DOUBLE INTEGERS, LEAVING DOUBLE 
( TWOS COMPLEMENT OF BOTTOM SINGLE NUMBER 
( TWOS COMPLEMENT OF BOTTOM DOUBLE NUMBER 
( DUPLICATE SECOND ITEM AS NEW BOTTOM 
( DROP BOTTOM STACK ITEM 
( EXCHANGE BOTTOM AND SECOND ITEMS ON STACK 
( DUPLICATE BOTTOM ITEM ON STACK 
ADD SECOND TO MEMORY 16 BITS ADDRESSED BY BOTTOM 
BYTE AT .ADDRESS-2, BIT PATTERN-1 ... 
( REPLACE STACK ADDRESS WITH 16 BIT 
( CONTENTS OF THAT ADDRESS 
STACK ADDRESS WITH POINTED 8 BIT BYTE 
SECOND AT 16 BITS ADDRESSED BY BOTTOM 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*)■ 

*) 

*) 

*) 

*) 

*)■ 

*) 

*) 

*) 


LDA 

( 


SECOND 

( 

PHA, 
REPLACE 
( STORE 


* ) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
* ) 
*) 
* ) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 


1 

6 

1 

8 

2 

9 

1 

2 

3 

1 

1 

2 

5 

7 

9 

11 


15 

1 5 

16 
16 
17 

17 

18 
18 
18 

19 

20 
20 
21 

2 1 
21 

21 


10 2 5 
1 26 
5 26 
8 26 
12 2 6 
1 27 
27 
27 

27 
27 

28 
28 
29 
29 
29 

o o 


2 

5 
8 

1 1 
2 

6 
1 
4 
9 

1 2 


1 

4 
7 

1 1 

2 

7 
1 
2 

5 

8 


30 

30 

30 
30 

31 

31 

32 
32 
3 2 
32 
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CODE 

C 1 


( STORE SECOND AT BYTE ADDRESSED BY BOTTOM 

*) 

12 

32 




( CREATE 

NEW COLON-DEFINITION UNTIL ' 

*) 

2 

33 

• > 





( TERMINATE COLON-DEFINITION 

*) 

9 

33 

: CONSTANT 



( WORD 

WHICH LATER CREATES CONSTANTS 

*) 

1 

34 

: VARIABLE 



( WORD 

WHICH LATER CREATES VARIABLES 

*) 

5 

34 

: USER 




( CREATE USER VARIABLE 

*) 

10 

34 

20 

CONSTANT RL 



CR ( ASCII BLANK 

*) 

4 

35 

4 0 

CONSTANT C/L 



(TEXT CHARACTERS PER LINE 

*) 

5 

35 

3BE0 

CONSTANT 

FIRST 

( FIRST BYTE RESERVED FOR BUFFERS 

*) 

7 

35 

4000 

CONSTANT 

LIMIT 


( JUST BEYOND TOP OF RAM 

*) 

8 

35 

80 

CONSTANT 

B/BUF 


( BYTES PER DISC BUFFER 

*) 

9 

35 

8 

CONSTANT 

B/SCR 

( BLOCKS PER SCREEN = 1024 B/BUF / 

*) 

10 

35 

: +ORIGIN 

LITERAL 

+ ; 

( LEAVES ADDRESS RELATIVE TO ORIGIN 

*) 

13 

35 

HEX 


( 

0 THRU 5 RESERVED, REFERENCED TO $00A0 

*) 

1 

36 

( 06 

USER 

SO ) 


( 

TOP OF EMPTY COMPUTATION STACK 

*) 

2 

36 

( 08 

USER 

RO ) 



( TOP OF EMPTY RETURN STACK 

*) 

3 

3 6 

OA 

USER 

TIB 



( TERMINAL INPUT BUFFER 

*) 

4 

36 

OC 

USER 

WIDTH 



( MAXIMUM NAME FIELD WIDTH 

*) 

5 

36 

OE 

USER 

WARNING 



( CONTROL WARNING MODES 

*) 

6 

36 

1 0 

USER 

FENCE 



CR ( BARRIER FOR FORGETTING 

*) 

7 

36 

12 

USER 

DP 



( DICTIONARY POINTER 

*) 

8 

36 

14 ' 

USER 

VOC-LINK 


( TO NEWEST VOCABULARY 

*) 

9 

36 

1 6 

USER 

BLK 



( INTERPRETATION BLOCK 

*) 

10 

36 

18 

USER 

IN 



( OFFSET INTO SOURCE TEXT 

*) 

11 

36 

lA 

USER 

OUT 



( DISPLAY CURSOR POSITION 

*) 

12 

36 

1C 

USER 

SCR 



( EDITING SCREEN 

*) 

13 

36 

IE 

USER 

OFFSET 



( POSSIBLY TO OTHER DRIVES 

*) 

1 

37 

20 

USER 

CONTEXT 



( VOCABULARY FIRST SEARCHED 

*) 

2 

37 

2 2 

USER 

CURRENT 


( 

SEARCHED SECOND, COMPILED INTO 

*) 

3 

37 

2 4 

USER 

STATE 



( COMPILATION STATE 

*) 

4 

37 

26 

USER 

BASE 


CR 

( FOR NUMERIC INPUT-OUTPUT 

*) 

5 

37 

2 8 

USER 

DPL 



( DECIMAL POINT LOCATION 

*) 

6 

37 

2A 

USER 

FLD 



( OUTPUT FIELD WIDTH 

*) 

7 

37 

2C 

USER 

CSP 



( CHECK STACK POSITION 

*) 

8 

37 

2E 

USER 

R// 



( EDITING CURSOR POSITION 

*) 

9 

3 7 

30 

USER 

HLD 

( 

POINTS 

TO LAST CHARACTER HELD IN PAD 

*) 

10 

3 7 

: 1 + 

1 

+ ; 


( 

INCREMENT STACK NUMBER BY ONE 

*) 

1 

38 

: 2+ 

2 

+ ; 


( 

INCREMENT STACK NUMBER BY TWO 

*) 

2 

38 

: HERE DP @ ; 


(FETCH NEXT FREE ADDRESS IN DICT. 


3 

38 

: AL 

LOT DP +! ; 



( MOVE DICT. POINTER AHEAD 


4 

38 

• » 

HERE 

! 2 

ALLOT 

; CR 

( ENTER STACK NUMBER TO DICT. 

*) 

5 

3 8 

: C, 

HERE 

C! 1 

ALLOT ; 

( ENTER STACK BYTE TO DICT. 

*) 

6 

38 

: -* 

MINUS 

+ ; 



( LEAVE DIFF. SEC - BOTTOM 

*) 

7 

38 

: =s 

- 0= 

> 



( LEAVE BOOLEAN OF EQUALITY 

*) 

8 

38 

: < 

- 0< 




( LEAVE BOOLEAN OF SEC < BOT 

*) 

9 

3 8 

: > 

SWAP 

< ; 



( LEAVE BOOLEAN OF SEC > BOT 

*) 

10 

38 

: ROT >R 

SWAP 

R> SWAP ; 

(ROTATE THIRD TO BOTTOM 

*) 

1 1 

38 

: SPACE 

BL EMIT ; 

CR 

( PRINT BLANK ON TERMINAL 

*) 

1 2 

38 

; -DUP 

DUP IF 

DUP 

END IF 

; ( DUPLICATE NON-ZERO 

*) 

13 

38 

: TRAVERSE 




( MOVE ACROSS NAME FIELD 

*) 

1 

3 9 


( 

ADDRESS 

-2, DIRECTION-1, I.E. -1=R TO L, +1=L TO R 

*) 

2 

39 

: LATEST 

CURRENT 


; ( NFA OF LATEST WORD 

*) 

6 

39 

: LFA 4 




( CONVERT A WORDS PFA TO LFA 

*) 

1 1 

3 9 

: CFA 2 

““ 3 

CR 


( CONVERT A WORDS PFA TO CFA 

*) 

1 2 

39 

: NFA 5 

- - 1 

TRAVERSE ; 

( CONVERT A WORDS PFA TO NFA 

*) 

1 3 

3 9 

: PFA 1 

TRAVERSE 5 

+ ; 

( CONVERT A WORDS NFA TO PFA 

*) 

14 

39 

: ICSP 

SP@ CSP ! 

3 

( SAVE STACK POSITION IN 'CSP' 

*) 

1 

40 




FORTH INTEREST GROUP 


MAY 1, 1979 







TERROR 
?COMP 
?EXEC 
?PAIRS 
?CSP 
TLOADING 
COMPILE 
[ 0 

] GO 


( BOOLEAN-2, ERROR TYPE-1, WARM FOR TRUE 
STATE 0 0= 11 TERROR ; (ERROR IF NOT COMPILING 
STATE 0 12 TERROR ; ( ERROR IF NOT EXECUTING 
- 13 TERROR ; ( VERIFY STACK VALUES ARE PAIRED 


SP@ CSP 0 


STATE 

STATE 


• 14 TERROR 

COMPILE THE 
IMMEDIATE 


; ( VERIFY STACK POSITION 

( VERIFY LOADING FROM DISC 
EXECUTION ADDRESS FOLLOWING 
( STOP COMPILATION 
( ENTER COMPILATION STATE 


*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 

*) 


3 40 

6 40 
8 40 
10 40 
12 40 
14 40 
2 4 1 

5 41 

7 41 


SMUDGE 


LATEST 

20 TOGGLE 

; ( ALTER LATEST WORD NAME 

*) 

9 

41 

HEX 


10 BASE ! ; 

( MAKE HEX THE IN-OUT BASE 

*) 

11 

41 

DECIMAL 


OA BASE ! ; 

( MAKE DECIMAL THE. IN-OUT BASE 

*) 

13 

41 

( ;CODE) 


( WRITE CODE FIELD POINTING TO CALLING ADDRESS 

*) 

2 

42 

;CODE 



( 

TERMINATE A NEW DEFINING WORD 

*) 

6 

42 

<BUILDS 


0 CONSTANT ; ( 

CREATE HEADER FOR 'DOES>' WORD 

*) 

2 

4 3 

DOES> 


( 

REWRITE PFA 

WITH CALLING HI-LEVEL ADDRESS 

*) 

4 

43 




( 

REWRITE CFA WITH 'D0ES>' CODE 

*) 

5 

43 

COUNT 


DUP 1 + 

SWAP C@ ; 

( LEAVE TEXT ADDR. CHAR. COUNT 

*) 

1 

44 

TYPE 



( TYPE STRING FROM ADDRESS-2, CHAR.COUNT-1 

*) 

2 

4 4 

-TRAILING 

( 

ADJUST CHAR. 

COUNT TO DROP TRAILING BLANKS 

*) 

5 

44 

(.") 



( TYPE IN 

-LINE STRING, ADJUSTING RETURN 

*) 

8 

4 4 

2 2 

STATE 

0 ( 

COMPILE OR PRINT QUOTED STRING 

*) 

12 

44 

EXPECT 



( TERMINAL 

INPUT MEMORY-2, CHAR LIMIT-1 

*) 

2 

45 

X BLK 

fd 



( END-OF-TEXT IS NULL 

*) 

11 

45 

FILL 



( FILL MEMORY BEGIN-3, QUAN-2, BYTE-1 

*) 

1 

46 

ERASE 



( FILL MEMORY WITH ZEROS BEGIN-2, QUAN-1 

*) 

4 

46 

BLANKS 



( FILL WITH BLANKS BEGIN-2, QUAN-1 

*) 

7 

46 

HOLD 




( HOLD CHARACTER IN PAD 

*) 

10 

46 

PAD 


HERE 

44 + ; 

( PAD IS 68 BYTES ABOVE HERE 

*) 

13 

4 6 

( 

DOWNWARD 

HAS NUMERIC 

OUTPUTS; UPWARD MAY HOLD TEXT 

*) 

14 

4 6 

WORD 


( ENTER WITH DELIMITER, MOVE STRING TO 'HERE' 

*) 

1 

47 

(NUMBER) 


(CONVERT DOUBLE 

NUMBER, LEAVING UNCONV. ADDR. 

*) 

1 

48 

NUMBER 


( 

ENTER W/ STRING ADDR. LEAVE DOUBLE NUMBER 

*) 

6 

4 8 

-FIND 


( RETURN PFA-3, : 

LEN BYTE-2, TRUE-1; ELSE FALSE 

*) 

12 

48 

(ABORT) 


GAP 

( ABORT ) ; 

(USER ALTERABLE ERROR ABORT 

*) 

2 

49 

ERROR 



( WARNING 

: -l=ABORT, 0=N0 DISC, 1=DISC 

*) 

4 

49 

WARNING 

0 0< 

( 

PRINT TEXT LINE REL TO SCR #4 

*) 

5 

49 

ID • 



( PRINT NAME 

FIELD FROM ITS HEADER ADDRESS 

*) 

9 

49 


CREATE 

[COMPILE] 

LITERAL 
DLITERAL 
TSTACK 

INTERPRET ( 
IMMEDIATE 
VOCABULARY ( 
VOCABULARY FORTH 
DEFINITIONS 
( 

QUIT 
ABORT 
CODE COLD 
CODE S->D 

: +- 0< IF MINUS 

: D+- 

: ABS DUP 


( A SMUDGED CODE HEADER 
(WARNING IF DUPLICATING 
( FORCE COMPILATION OF AN 
( IF COMPILING, 
(IF COMPILING, CREATE 


TO PARAM FIELD *) 
A CURRENT NAME *) 
IMMEDIATE WORD *) 
CREATE LITERAL *) 
DOUBLE LITERAL *) 

( QUESTION UPON OVER OR UNDERFLOW OF STACK *) 
INTERPRET OR COMPILE SOURCE TEXT INPUT WORDS *) 

( TOGGLE PREC,. BIT OF LATEST CURRENT WORD *) 
CREATE VOCAB WITH 'V-HEAD' AT VOC INTERSECT. *)' 
IMMEDIATE ( THE TRUNK VOCABULARY *)' 

( SET THE CONTEXT ALSO AS CURRENT VOCAB *)' 
( SKIP INPUT TEXT UNTIL RIGHT PARENTHESIS *)' 
( RESTART, INTERPRET- FROM TERMINAL *)' 
( WARM RESTART, INCLUDING REGISTERS *)' 
( COLD START, INITIALIZING USER AREA *)' 
( EXTEND SINGLE INTEGER TO DOUBLE *)' 
ENDIF ; ( APPLY SIGN TO NUMBER BENEATH *)' 

( APPLY SIGN TO DOUBLE NUMBER BENEATH *)' 
+- ; ( LEAVE ABSOLUTE VALUE *)' 


2 50 

3 50 
2 51 

5 51 

8 51 

13 51 
2 52 

1 53 

4 5 3 

9 53 
11 5 3 

14 5 3 

2 5 4 
7 54 
1 5 5 
1 56 
4 56 

6 56 
9 5 6 


FORTH INTEREST GROUP 


MAY 1, 1979 








DABS 

DUP 

D+- ; 


( 

DOUBLE INTEGER ABSOLUTE VALUE 

MIN 





(LEAVE SMALLER OF TWO NUMBERS 

MAX 





( LEAVE TARGET OF TWO NUMBERS 

M* 

( LEAVE SIGNED 

DOUBLE 

PRODUCT OF TWO SINGLE NUMBERS 

M/ 


( FROM 

SIGNED 

DOUBLE-3-2, SIGNED DIVISOR-1 



( LEAVE 

SIGNED 

REMAINDER-2, SIGNED QUOTIENT-1 

* 

U* DROP ; 



( SIGNED PRODUCT 

/MOD 

>R S- 

V 

a 

V 


M/ ; 

( LEAVE REM-2, QUOT-1 

/ 

/MOD 

SWAP 

DROP ; 

( LEAVE QUOTIENT 

MOD 

/MOD 

DROP 

f 

CR 

( LEAVE REMAINDER 

*/MOD 



( 

TAKE RATION OF THREE NUMBERS, LEAVING 


>R M* 

R> 

M/ 

> 

( REM-2, QUOTIENT-1 

*/ 

*/MOD 

SWAP 

DROP ; 

( LEAVE RATIO OF THREE NUMBS 


: M/MOD ( DOUBLE, SINGLE DIVISOR ... REMAINDER, DOUBLE 

FIRST VARIABLE USE ( NEXT BUFFER TO USE, STALEST 

FIRST VARIABLE PREV ( MOST RECENTLY REFERENCED BUFFER 

; +BUF ( ADVANCE ADDRESS-1 TO NEXT BUFFER. RETURNS FALSE 

84 ( I.E. B/BUF+4 ) + DUP LIMIT = ( IF AT PREV 

UPDATE ( MARK THE BUFFER POINTED TO BY PREV AS ALTERED 

EMPTY-BUFFERS C CLEAR BLOCK BUFFERS; DON'T WRITE TO DISC 


DRO 0 

DRl 07D0 

BUFFER 

BLOCK 

(LINE) 

.LINE 

MESSAGE 

LOAD 


OFFSET 

OFFSET 


! ; —> 

( CONVERT BLOCK# 
( CONVERT BLOCK NUMBER TO 
( LINE#, SCR#, ... 


( SELECT DRIVE #0 
( SELECT DRIVE #1 
TO STORAGE ADDRESS 
ITS BUFFER ADDRESS 


--> 

6900 CONSTANT 

6901 CONSTANT 
; #HL 

CODE D/CHAR 
: ?DISC 

1 D/CHAR 
CODE BLOCK-WRITE 

2 # LDA, 
BLOCK-READ 


.. BUFFER ADDRESS, 64 COUNT 
( LINE#, SCR#, ... PRINTED 
( PRINT LINE RELATIVE TO SCREEN #4 OF DRIVE 0 

( INTERPRET SCREENS FROM DISC 
( CONTINUE INTERPRETATION ON NEXT SCREEN 
DATA ( CONTROLLER PORT 

STATUS ( CONTROLLER PORT 

C CONVERT DECIMAL DIGIT FOR DISC CONTROLLER 


EXIT TEST 


BOOL-2, NEW CHAR-1 


ERR MSG 


CODE 


R/W 


FORGET 
\ 

BACK 
D.R 

D. 

.R 

• 

? 

LIST 
INDEX 
TRIAD 
VL 1ST 
CREATE 


QUIT. ABSORBS TILL 
EOT, EXCEPT FOR SOH 
ADDRESS-2, COUNT-1 
( WITH EOT AT END 
128 CHAR OR CONTROL ’ 


( TEST CHAR-1. 

( UPON NAK SHOW 
>R 0= ( 

( SEND TO DISC FROM 
SETUP JSR, 

( BUF.ADDR-l. EXIT AT 

( C= I TO READ, 0 TO WRITE 
( READ/WRITE DISC BLOCK 
(BUFFER ADDRESS-3, BLOCK #-2, 1=READ 0=WRITE 
(FIND NEXT WORDS PFA; COMPILE IT, IF COMPILING 
( FOLLOWING WORD FROM CURRENT VOCABULARY 
( SKIP INTERPRETATION OF THE REMAINDER’ OF LINE 


HERE - , ; 

( DOUBLE INTEGER 
0 D.R SPACE ; 

>R S->D R> D.R; 
S->D D. ; 

@ ; 

( 


MON 


( RESOLVE BACKWARD BRANCH 
OUTPUT, RIGHT ALIGNED IN FIELD 
( DOUBLE INTEGER OUTPUT 
( ALIGNED SINGLE INTEGER 
( SINGLE INTEGER OUTPUT 
( PRINT CONTENTS OF MEMORY 
LIST SCREEN BY NUMBER ON STACK 
( PRINT FIRST LINE OF EACH SCREEN FROM-2, TO-I 
( PRINT 3 SCREENS ON PAGE, CONTAINING # ON STACK 

( LIST CONTEXT VOCABULARY 
( CALL MONITOR, SAVING RE-ENTRY TO FORTH 


*) 

10 5 6 

*) 

12 56 

*) 

14 5 6 

*) 

1 5 7 

) 3 

5 7 

*) 

4 57 

*) 

7 57 

*) 

8 5 7 

*)_ 

9 57 

*) 

10 57 

*) 

11 57 

*)” 

12 57 

*) 

13 57 

*) 

14 57 

*) 

1 58 

*) 

2 58 

*) 

4 5 8 

*) 

5 58 

*)_ 

8 58 

*) 

11 58 

*) 

14 58 

*) 

15 58 

*) 

1 59 

*) 

1 60 

*) 

2 61 

*) 

6 61 

*) 

9 61 

*) 

2 6 2 

*) 

6 62 

*) 

1 65 

*) 

2 65 

*) 

5 6 5 

*) 

16 6 

*) 

7 66 

*) 

8 6 6 

*) 

1 67 

*) 

2 6 7 

) 

2 68 

*) 

3 69 

*) 

4 69 

*) 

5 6 9 

*) 

2 7 2 

*) 

6 72 

*) 

11 72 

*) 

1 7 3 

*) 

1 7 6 

*) 

5 76 

*) 

7 76 

*) 

9 76 

*) 

11 76 

*) 

2 77 

*)_ 

7 77 

/ 

12 7 7 

*) 

2 78 

*)_ 

3 79 







FORTH MODEL IMPLEMENTATION 


This model is presented for the serious student as 
both an example of a large FORTH program and as a complete 
nucleus of FORTH, That is, it is sufficient to run and 
to continue to compile itself. 

When compiled, the model requires about 2800 bytes of 
memory. An expanded version with formatted output and 
compiling aids would require about 4 OOO bytes, A ’full' 
implementation usually requires 6000 to 7000 bytes 
(including editor, assembler, and disk interface). 

The following information consists of word definitions 
you will find in the CODE definitions. These are dependent 
on the micro-computer used, these being for the MOS Technology 
5602, 

Note that the notation in the CODE definitions is 
'reverse Polish' as is all of FORTH, This means that the 
operand comes before the operator. Each equivalent of a 
'line' of assembly code has a symbolic operand, then 
any address mode modifier, and finally the op-code mnemonic, 
(Note that words that generate actual machine code end in 
a ',' ; i,e, LDA, ), Therefor: 

BOT 1+ LDA, in FORTH would be: 

LDA 1,X in usual assembler. 

And also: 

POINTER )Y STA, in FORTH would be: 

STA (POINTER),! in usual assembler. 


It takes a bit of getting used to, but reverse Polish 
assembler allows full use of FORTH in evaluation of 
expressions and the easy generation of the equivalent of macros. 


GLOSSARY OF FORTH MODEL 


IP address of the Interpretive Pointer in zero-page, 

W address of the code field pointer in zero-page, 

N address of an 8 byte scratch area in zero-page, 

XSAVE address of a temporary register for X in zero-page. 


liT 


UP 


address of the User Pointer i 


n zero-page. 



GLOSSARY OF FORTH MODEL, cont. 


.A 

i£ 


ft 

,x 


X) 

n 

BOT 


BOT 

1 + 

SEC 

and 

TSX, 

1 

R 

i 

R n 

+ i 


PUT 


PUSH 


specify accumulator address mode, 

specify immediate mode for machine byte literals. 

specify memory indexed address mode. 

specify indirect memory reference by a zero-page register 

address of high byte of a l6-bit stack item with 

stack^irzero‘^na„e^ register locates computation 
acK in zero-page, relative to address loOOO. 

address of the low byte of the bottom stack item, 

With ,X mode preset. 


move the return stack pointer (which is located in 

the CPU machine stack in page-one) to X register. 

address of low byte of return stack with ,X mode preset, 

iress of the n-th byte of the return stack with ,X 
mode preset. Note that the low byte is at low 
memory, so 1+ gets the high byte, and 3 + gets 
the high byte of the second item of return stack. 

address of routine to replace the present computation 
stack high byte from accumulator, and put from 
the machine stack one byte which replaces the 
present low stack byte; continue on to NEXT. 

address of routine to repeat PUT but creating a new 
bottom item on the computation stack. 


PUSHOA PUTOA address of routine to place the accumulator 

stack byte, with the high byte zero. 

PUTOA over-writes, while PUSHOA creates new item. 

POP POPTWO address of routine to remove one or two 16-bit 
items from computation stack. 

BINARY address of routine to pop one item and PUT the accumulator 
(high) and ML stack (low) over what was second. 

SETUP address of a routine to move 16-bit items to zero-page. 
Item quantity is in accumulator. 


NEXT address of the inner-interpreter, to which all 
code routines must return. NEXT fetches 
indirectly referred to IP the next compiled 
FORTH word address. It then Jumps indirectly 
to pointed machine code. 



WFR-780519 ) 


SCR # 6 

0 ( INPUT-OUTPUT, TIM 

1 CODE EMIT XSAVE STX, EOT 1+ LDA, 7F # AND, 

2 72C6 JSR, XSAVE LDX, POP JMP, 

3 CODE KEY XSAVE STX, BEGIN, BEGIN, 8 // LDX, 

4 BEGIN, 6E02 LDA, .A LSR, CS END, 7320 JSR, 

5 BEGIN, 731D JSR, 0 X) CMP, 0 X) CMP, 0 X) CMP, 

6 0 X) CMP, 0 X) CMP, 6E02 LDA, .A LSR, PHP, TYA, 

7 .A LSR, PLP, CS IF, 80 // ORA, THEN, TAY, DEX, 

8 0= END, 731D JSR, FF # EOR, 7F // AND, 0= NOT END, 

9 7F // CMP, 0= NOT END, XSAVE LDX, PUSHOA JMP, 

10 CODE CR XSAVE STX, 728A JSR, XSAVE LDX, NEXT JMP, 

11 

12 CODE 7TERMINAL 1 # LDA, 6E02 BIT, 0= NOT IF, 

13 BEGIN, 731D JSR, 6E02 BIT, 0= END, INY, THEN, 

14 TYA, PUSHOA JMP, 

15 DECIMAL ;S 


SCR // 7 

0 ( INPUT-OUTPUT, APPLE WFR-780730 ) 

1 CODE HOME FC5,8 JSR, NEXT JMP, 

2 CODE SCROLL FfcZO JSR, NEXT JMP, 

3 

4 HERE ' KEY 2 - ! (POINT KEY TO HERE ) 

5 FDOC JSR, 7F // AND, PUSHOA JMP, 

6 HERE ' EMIT 2 - ! ( POINT EMIT TO HERE ) 

7 BOT 1+ LDA, 80 # ORA, FDED JSR, POP JMP, 

8 HERE ' CR 2 - I ( POINT CR TO HERE ) 

9 FD8E JSR, NEXT JMP, 

10 HERE ' 7TERMINAL 2-1 ( POINT ?TERM TO HERE ) 

11 COOO BIT, 0< 

12 IF, BEGIN, COlO BIT, COOO BIT, 0< NOT END, INY, 

13 THEN, TYA, PUSHOA JMP, 

14 

15 DECIMAL ;S 


SCR # 8 

0 ( INPUT-OUTPUT, SYM-1 

1 HEX 

2 CODE KEY 8A58 JSR, 7F /A AND, PUSHOA JMP, 

3 

4 CODE EMIT BOT 1+ LDA, 8A47 JSR, POP JMP, 

5 

6 CODE CR 834D JSR, NEXT JMP, 

7 

8 CODE 7TERMINAL ( BREAK TEST FOR ANY KEY ) 

9 8B3C JSR, CS 

10 IF, BEGIN, 8B3C JSR, CS NOT END, INY, 

11 TYA, PUSHOA JMP, 

1 2 

13 

14 

15 DECIMAL ;S 

FORTH INTEREST GROUP MAY 1, 1979 


WFR-781015 ) 


THEN, 


^7 



SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 
1 3 
1 4 
15 


# 12 
( COLD 
ASSEMBL 
NOP, 

NOP , 
0000 , 
0000 
7F 
3BA0 
009E 
OlFF 
0100 
OOIF 
0001 
0200 
0000 
0000 


AND WARM ENTRY, 
ER OBJECT MEM 


USER PARAMETERS 
HEX 


WFR-79APR29 ) 


HERE JMP, ( WORD ALIGNED VECTOR TO COLD ) 

HERE JMP, (WORD ALIGNED VECTOR TO WARM ) 

0001 , ( CPU, AND REVISION PARAMETERS ) 

( TOPMOST WORD IN FORTH VOCABULARY 
( BACKSPACE CHARACTER ) 

( INITIAL USER AREA ) 

( INITIAL TOP OF STACK ) 

( INITIAL TOP OF RETURN STACK ) 

( TERMINAL INPUT BUFFER ) 

( INITIAL NAME FIELD WIDTH ) 

( INITIAL WARNING = 1 ) 

( INITIAL FENCE ) 

( COLD START VALUE FOR DP ) 

( COLD START VALUE FOR VOC-LINK ) 


--> 


SCR # 13 

0 ( START OF NUCLEUS 

1 CODE LIT 

2 IP )Y LDA, PHA, 

3 IP )Y LDA, 

4 LABEL PUSH ( PUSH 

5 DEX, DEX, 

6 LABEL PUT 

7 BOT 1+ STA, 

8 LABEL NEXT 


LIT, PUSH, PUT, NEXT 
( PUSH FOLLOWING 


WFR-78DEC26 ) 
LITERAL TO STACK *) 


IP INC, 
IP INC, 
ACCUM AS 


0= IF, IP 1+ INC, THEN, 

0= IF, IP 1+ INC, THEN, 
HI-BYTE, ML STACK AS LO-BYTE *) 

ACCUM. AND ML STACK *) 


9 

1 it LDY, IP 

1 0 

DEY, IP 

1 1 

CLC, IP LDA, 

12 

CS IF, IP 1+ 

13 

14 

15 —> 

W 1 - JMP, 


( REPLACE BOTTOM WITH 
PLA, BOT STA, 

( EXECUTE NEXT FORTH ADDRESS, MOVING IP *) 
)Y LDA, W 1+ STA, 


)Y LDA, W 
2 # ADC, 


STA, 
IP STA, 


INC, 

( JUMP 


THEN, 

INDIR, 


(FETCH CODE ADDRESS ) 
( MOVE IP AHEAD ) 


VIA W THRU CODE FIELD TO CODE ) 


SCR # 14 

0 ( SETUP 
1 


HERE 2+ 


WFR-790225 ) 
( MAKE SILENT WORD *) 


IP )Y LDA, PHA, TYA, 'T LIT OB + 0= NOT END, 


2 

3 

4 LABEL SETUP ( MOVE it ITEMS FROM STACK TO 'N' AREA OF Z-PAGE *) 

5 .A ASL, N 1 - STA, 

6 

7 

8 


BEGIN, BOT LDA, 
N 1 - CPY, 


N ,Y STA, INX, INY, 
0= END, 0 it LDY, RTS, 


9 CODE EXECUTE 
10 

11 BOT LDA, W STA, 

12 INX, INX, W 1 - JMP, 

13 

14 

15 —> 


( EXECUTE A WORD BY ITS CODE FIELD *) 
( ADDRESS ON THE STACK *) 
BOT 1+ LDA, W 1+ STA, 


FORTH INTEREST GROUP 
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SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 

13 

14 

15 


ir I ^ 

( BRANCH, OBRANCH 
CODE BRANCH 

CLC, IP )Y LDA, 
INY, IP )Y LDA, 


W/16-BIT OFFSET WFR-79APR01 ) 

( ADJUST IP BY IN-LINE 16 BIT LITERAL *) 

IP ADC, PHA, 

IP 1+ ADC, IP 1+ STA, 

PLA, IP STA, NEXT 2+ JMP, 


CODE OBRANCH ( IF BOT IS ZERO, BRANCH FROM LITERAL *) 

INX, INX, FE ,X LDA, FF ,X ORA, 

' BRANCH 0= NOT END, ( USE 'BRANCH' FOR FALSE ) 

LABEL BUMP; ( TRUE JUST MOVES IP 2 BYTES *) 

CLC, IP LDA, 2 # ADC, IP STA, 

CS IF, IP 1+ INC, THEN, NEXT JMP, 

--> 


SCR # 16 

0 ( LOOP CONTROL WFR-79MAR20 ) 

1 CODE (LOOP) ( INCREMENT LOOP INDEX, LOOP UNTIL »> LIMIT *) 

2 XSAVE STX, TSX, R INC, 0- IF, R 1+ INC, THEN, 

3 LABEL LI: CLC, R 2+ LDA, R SBC, R 3 + LDA, R 1+ SBC, 

4 LABEL L2: XSAVE LDX, (LIMIT-INDEX-1 ) 

5 .A ASL, ' BRANCH CS END, ( BRANCH UNTIL D7 SIGN=1 ) 

6 PLA, PLA, PLA, PLA, BUMP: JMP, ( ELSE EXIT LOOP ) 


8 

CODE (+LOOP) 

( INCREMENT INDEX BY STACK VALUE 

4/- *) 

9 

INX, 

INX, 

XSAVE STX, 

( POP INCREMENT ) 


10 

FF ,X 

LDA, 

PHA, PHA, 

FE , 

X LDA, TSX, INX. INX. 

1 1 

CLC, 

R ADC 

, R STA, 

PLA, 

R 1 4 ADC, R 1 4 STA, 


1 2 

PLA, 

LI : 

0< END, 

( AS 

FOR POSITIVE INCREMENT 

) 

1 3 

CLC , 

R 

LDA, R 2+ 

SBC, 

( INDEX-LIMIT-1 ) 


1 4 


R 1 + 

LDA, R 3 4 

■ SBC, 

L2: JMP, 


15 

— >' 






SCR 

» 17 






0 

1 

( (DO- 




WFR- 

79MAR30 ) 

2 

CODE (DO) 


( MOVE TWO 

STACK ITEMS TO RETURN 

STACK *) 

3 

SEC 1 + 

LDA, 

PHA, SEC 

LDA, 

PHA, 


4 

5 

BOT 1 + 

LDA, 

PHA, BOT 

LDA, 

PHA, 


6 

LABEL POPTWO 

INX, INX, 




7 

o 

LABEL POP 


INX, INX, 

NEXT 

JMP, 



9 

10 
1 1 
1 2 
1 3 

14 

15 


CODE I 


--> 


( COPY CURRENT LOOP INDEX TO STACK *) 
( THIS WILL LATER BE POINTED TO 'R' ) 


FORTH INTEREST GROUP 
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SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
1 3 

14 

15 


// 18 

( DIGIT 
CODE DIGIT 


SEC, SEC LDA, 

0< NOT IF, OA // 
0< NOT 


WFR-781202 ) 

( CONVERT ASCII CHAR-SECOND, WITH BASE-BOTTOM *) 
( IF OK RETURN DIGIT-SECOND, TRUE-BOTTOM; *) 

( OTHERWISE FALSE-BOTTOM. *) 

30 // SBC, 

CMP, ( ADJUST FOR ASCII LETTER ) 

IF, SEC, 07 // SBC, OA // CMP, 

0< NOT IF, 

SWAP ( AT COMPILE TIME ) THEN, BOT CMP, ( TO BASE ) 

0< IF, SEC STA, 1 if LDA, 

PHA, TYA, PUT JMP, 

(STORE RESULT SECOND AND RETURN TRUE ) 
THEN, THEN, THEN, ( CONVERSION FAILED ) 

TYA, PHA, INX, INX, PUT JMP, ( LEAVE BOOLEAN FALSE ) 

.-> 


SCR #19 

0 ( find for variable LENGTH NAMES WFR-790225 ) 

1 CODE (FIND) ( HERE, NFA ... PFA, LEN BYTE, TRUE; ELSE FALSE *) 

2 2 if LDA, SETUP JSR, XSAVE STX, 

3 BEGIN, 0 if LDY, N )Y LDA, N 2+ )Y EOR, 3F # AND, 0« 

4 IF, ( GOOD ) BEGIN, INY, N )Y LDA, N 2+ )Y EOR, .A ASL, 0= 

5 IF, ( STILL GOOD ) SWAP CS (LOOP TILL D7 SET ) 

6 END, XSAVE LDX, DEX, DEX, DEX, DEX, CLC, 

7 TYA, 5 if ADC, N ADC, SEC STA, 0 if LDY, 

8 TYA, N 1+ ADC, SEC 1+ STA, BOT 1+ STY, 

9 N )Y LDA, BOT STA, 1 if LDA, PHA, PUSH JMP, ( FALSE ) 

10 THEN, CS NOT ( AT LAST CHAR? ) IF, SWAP THEN, 

11 BEGIN, INY, N )Y LDA, 0< END, ( TO LAST CHAR ) 

12 THEN, INY, ( TO LINK ) N )Y LDA, TAX, INY, 

13 N )Y LDA, N 1+ STA, N STX, N ORA, ( 0 LINK ? ) 

14 0= END, (LOOP FOR ANOTHER NAME ) 

15 XSAVE LDX, 0 if LDA, PHA, PUSH JMP, ( FALSE ) —> 


SCR # 20 

0 ( ENCLOSE WFR-780926 ) 

1 CODE ENCLOSE ( ENTER WITH ADDRESS-2, DELIM-1. RETURN WITH *) 

2 ( ADDR-4, AND OFFSET TO FIRST CH-3, END WORD-2, NEXT CH-1 *) 

3 2 if LDA, SETUP JSR, TXA, SEC, 8 if SBC, TAX, 

4 SEC 1+ STY, BOT 1+ STY, ( CLEAR HI BYTES ) DEY, 

5 BEGIN, INY, N 2+ )Y LDA, ( FETCH CHAR ) 

6 N CMP, 0*= NOT END, ( STEP OVER LEADING DELIMITERS ) 

7 BOT 4 + STY, ( SAVE OFFSET TO FIRST CHAR ) 

8 BEGIN, N 2+ )Y LDA, 0= 

9 IF, ( NULL ) SEC STY, ( IN EW ) BOT STY, ( IN NC ) 

10 TYA, BOT 4 + CMP, 0= 

11 IF, ( Y»FC ) SEC INC, ( BUMP EW ) THEN, NEXT JMP, 

12 THEN, SEC STY, ( IN EW ) INY, N CMP, ( DELIM ? ) 

13 0= END, ( IS DELIM ) BOT STY, ( IN NC ) NEXT JMP, 

14 

15 — > 

FORTH INTEREST GROUP MAY 1, 1979 
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SCR // 21 

0 ( TERMINAL VECTORS WFR-79MAR30 ) 

1 (THESE WORDS ARE CREATED WITH NO EXECUTION CODE, YET. ) 

2 ( THEIR CODE FIELDS WILL BE FILLED WITH THE ADDRESS OF THEIR ) 

3 ( INSTALLATION SPECIFIC CODE. \ 

5 CODE EMIT ( PRINT ASCII VALUE ON BOTTOM OF STACK *) 

7 CODE KEY ( ACCEPT ONE TERMINAL CHARACTER TO THE STACK 

8 

^9 CODE 7TERMINAL ( 'BREAK' LEAVES 1 ON STACK; OTHERWISE 0 *) 

11 CODE CR (EXECUTE CAR. RETURN, LINE FEED ON TERMINAL *) 

13 --> 

14 

15 


#22 

( CMOVE, WFR-79MAR20 ) 

CODE CMOVE ( WITHIN MEMORY; ENTER W/ FROM-3, TO-2, QUAN-1 *) 
3 # LDA, SETUP JSR, ( MOVE 3 ITEMS TO 'N' AREA ) 

BEGIN, BEGIN, N CPY, 0= ( DECREMENT BYTE COUNTER AT 'N' ) 

IF, N 1+ DEC, 0< ( EXIT WHEN DONE ) 

IF, NEXT JMP, THEN, THEN, 

N 4 + )Y LDA, N 2+ )Y STA, INY, 0= 
end, ( LOOP till Y WRAPS, 22 CYCLES/BYTE ) 

N 5 + INC, N 3 + INC, ( BUMP HI BYTES OF POINTERS ) 

JMP, ( BACK TO FIRST 'BEGIN' ) 


# 23 
( U = 
CODE 


UNSIGNED MULTIPLY FOR 16 BITS 
( 16 BIT MULTIPLICAND-2 
( 32 BIT UNSIGNED PRODUCT 
LDA, N STA, SEC STY, 
+ LDA, N 1+ STA, SEC 1+ STY, 


3EC LDA, 
3EC 1+ LDA, 
LO # LDY, 
5EGIN, BOT 


2+ ASL, 


WFR-79APR08 ) 
16 BIT MULTIPLIER-1 *) 
LO WORD-2, HI WORD-1 *) 

( MULTIPLICAND TO N ) 


ROL, 


ROL, 


1+ ROL, 


( DOUBLE PRODUCT WHILE SAMPLING D15 OF MULT ) 
IF, ( SET ) CLC, 

( ADD MULTIPLICAND TO PARTIAL PRODUCT LOW 24 BITS 


END, 


N LDA, BOT 
N 1+ LDA, BOT 
0 # LDA, BOT 

THEN, DEY, 0= 
NEXT JMP, 


ADC , 
ADC , 
ADC , 


+ STA, 
+ STA, 
STA, 


FORTH INTEREST GROUP 


19 79 


3 / 



SCR # 24 

0 ( U/, UNSIGNED DIVIDE FOR 31 BITS WFR-79APR29 ) 

1 CODE U/ ( 31 BIT DIVIDEND-2, -3, 16 BIT DIVISOR-1 *) 

2 (16 BIT REMAINDER-2, 16 BIT QDOTIENT-1 *) 

3 SEC 2 + LDA, SEC LDY, SEC 2 + STY, .A ASL, SEC STA 

4 SEC 3 + LDA, SEC 1+ LDY, SEC 3 + STY, .A ROL, SEC 1+ STA 

5 10 it LDA, N STA, 

6 BEGIN, SEC 2 + ROL, SEC 3 + ROL, SEC, 

7 SEC 2 + LDA, BOT SBC, TAY, 

8 SEC 3 + LDA, BOT 1+ SBC, 

9 CS IF, SEC 2+ STY, SEC 3 + STA, THEN, 

10 SEC ROL, SEC 1+ ROL, 

11 N DEC, 0= 

12 END, POP JMP, 

13 —> 

14 

15 


SCR if 25 

0 ( LOGICALS 
1 

2 CODE AND 

3 BOT LDA, 

4 BOT 1+ LDA, 

5 

6 CODE OR 

7 BOT LDA, 

8 BOT 1+ LDA, 

9 

10 CODE XOR 

11 BOT LDA, 

12 BOT 1+ LDA, 

1 3 

14 --> 

15 


WFR-79APR20 ) 

( LOGICAL BITWISE AND OF BOTTOM TWO ITEMS *) 
SEC AND, PHA, 

SEC 1+ AND, INX, INX, PUT JMP, 

( LOGICAL BITWISE 'OR' OF BOTTOM TWO ITEMS *) 
SEC ORA, PHA, 

SEC 1 + ORA, INX, INX, PUT JMP, 

( LOGICAL 'EXCLUSIVE-OR' OF BOTTOM TWO ITEMS *) 
SEC EOR, PHA, 

SEC 1+ EOR, INX, INX, PUT JMP, 


SCR if 2 6 


0 ( STACK INITIALIZATION 

1 CODE SP@ 

2 TXA, 

3 LABEL PUSHOA PHA, 0 if LDA, 

4 


5 

CODE SP! 




6 

0 6 if LDY, 

UP ) Y 

LDA, 

TAX, 

7 





8 

CODE RP! 




9 

XSAVE STX, 

08 if 

LDY, 

UP ) 

1 0 


XSAVE 

LDX, 

NEXT 

1 1 





1 2 

CODE ;S 


( RESTORE 


1 3 PLA, IP STA, PLA, IP 1 + 
1 4 

15 —> 


WFR-79MAR30 ) 
( FETCH STACK POINTER TO STACK *) 

PUSH JMP, 

( LOAD SP FROM 'SO' *) 

NEXT JMP, 

( LOAD RP FROM RO *) 
I LDA, TAX, TXS, 

JMP , 

IP REGISTER FROM RETURN STACK *) 
)TA, NEXT JMP, 


FORTH INTEREST GROUP 


MAY 1, 1979 


SCR // 2 7 

0 ( RETURN STACK WORDS WFR-7 

1 CODE LEAVE ( FORCE EXIT OF DO-LOOP BY SETTING 

2 XSAVE STX, TSX, R LDA, R 2+ STA, ( TO 

3 R 1+ LDA, R 3 + STA, XSAVE LDX, NEXT JMP, 

4 

5 CODE >R ( MOVE FROM COMP. STACK TO RETURN 

6 BOT 1+ LDA, PHA, BOT LDA, PHA, INX, INX, NEXT 

8 CODE R> ( move FROM RETURN STACK TO COMP. 

9 DEX, DEX, PLA, BOT STA, PLA, BOT 1+ STA, NEXT 

10 

11 CODE R ( COPY THE BOTTOM OF RETURN STACK TO COMP. 

12 XSAVE STX, TSX, R LDA, PHA, R 1+ LDA, 

13 XSAVE LDX, PUSH JMP, 

14 ' R -2 BYTE.IN I ! 

15 --> 


9MAR29 ) 
LIMIT *) 
INDEX *) 


STACK *) 
JMP , 

STACK *) 
JMP , 

STACK *) 


// 28 

( TESTS AND LOGICALS 


WFR-79MAR19 ) 


CODE 0= (REVERSE LOGICAL STATE OF BOTTOM OF STACK *) 

BOT LDA, BOT 1+ ORA, BOT 1+ STY, 

0= IF, INY, THEN, BOT STY, NEXT JMP, 

CODE 0< ( LEAVE TRUE IF NEGATIVE; OTHERWISE FALSE *) 

BOT 1+ ASL, TYA, .A ROL, BOT 1+ STY, BOT STA, NEXT JMP, 


it 2 9 
( MATH 
CODE + 

CLC, BOT 
SEC 

CODE D+ 

CLC, BOT 
BOT 
BOT 
BOT 

CODE MINUS 
SEC, TYA 
TYA 

CODE DMINUS 
SEC, TYA 
TYA 
1 BYT 


WFR-79MAR19 ) 

( LEAVE THE SUM OF THE BOTTOM TWO STACK ITEMS *) 
LDA, SEC ADC, SEC STA, BOT 1+ LDA, SEC 1+ ADC, 
1+ STA, INX, INX, NEXT JMP, 

( ADD TWO DOUBLE INTEGERS, LEAVING DOUBLE *) 

2 + LDA, BOT 6 + ADC, BOT 6 + STA, 

3 + LDA, BOT 7 + ADC, BOT 7 + STA, 

LDA, BOT 4 + ADC, BOT 4 + STA, 

1 + LDA, BOT 5 + ADC, BOT 5 + STA, POPTWO JMP, 

( TWOS COMPLEMENT OF BOTTOM SINGLE NUMBER *) 


( TWOS COMPLEMENT OF BOTTOM SINGLE 
, BOT SBC, BOT STA, 

, BOT 1+ SBC, BOT 1+ STA, NEXT JMP, 

( TWOS COMPLEMENT OF BOTTOM DOUBLE 
, BOT 2 + SBC, BOT 2 + STA, 

, BOT 3 + SBC, BOT 3 + STA, 

E. IN MINUS JMP, —> 


NUMBER 


FORTH INTEREST GROUP 


MAY 1, 1979 



SCR # 30 

0 ( STACK MANIPULATION WFR-79MAR29 ) 

1 CODE OVER ( DUPLICATE SECOND ITEM AS NEW BOTTOM *) 

2 SEC LDA, PHA, SEC 1+ LDA, PUSH JMP, 

3 

4 CODE DROP ( DROP BOTTOM STACK ITEM *) 

5 POP -2 BYTE.IN DROP ! ( C.F. VECTORS DIRECTLY TO 'POP' ) 

6 

7 CODE SWAP ( EXCHANGE BOTTOM AND SECOND ITEMS ON STACK *) 

8 SEC LDA, PHA, BOT LDA, SEC STA, 

9 SEC 1+ LDA, BOT 1+ LDY, SEC 1+ STY, PUT JMP, 

10 


11 CODE DUP ( DUPLICATE BOTTOM ITEM ON STACK *) 

12 BOT LDA, PHA, BOT 1+ LDA, PUSH JMP, 

13 

14 --> 

15 


SCR // 31 

0 ( MEMORY INCREMENT, WFR-79MAR30 ) 

1 

2 CODE +! { ADD SECOND TO MEMORY 16 BITS ADDRESSED BY BOTTOM *) 

3 CLC, BOT X) LDA, SEC ADC, BOT X) STA, 

4 BOT INC, 0* IF, BOT 1+ INC, THEN, 

5 BOT X) LDA, SEC 1+ ADC, BOT X) STA, POPTWO JMP, 

6 

7 CODE TOGGLE ( BYTE AT ADDRESS-2, BIT PATTERN-1 ... *) 

8 SEC X) LDA, BOT EOR, SEC X) STA, POPTWO JMP, 

9 

10 --> 

11 

12 

13 

14 

15 


SCR // 32 

0 ( MEMORY FETCH AND STORE WFR-781202 ) 

1 CODE @ ( REPLACE STACK ADDRESS WITH 16 BIT *) 

2 BOT X) LDA, PHA, ( CONTENTS OF THAT ADDRESS *) 

3 BOT INC, 0- IF, BOT 1+ INC, THEN, BOT X) LDA, PUT JMP, 

4 

5 CODE C@ ( REPLACE STACK ADDRESS WITH POINTED 8 BIT BYTE *) 

6 BOT X) LDA, BOT STA, BOT 1+ STY, NEXT JMP, 

8 CODE ! ( STORE SECOND AT 16 BITS ADDRESSED BY BOTTOM *) 

9 SEC LDA, BOT X) STA, BOT INC, 0= IF, BOT 1+ INC, THEN, 

10 SEC 1+ LDA, BOT X) STA, POPTWO JMP, 

11 

12 CODE C! ( STORE SECOND AT BYTE ADDRESSED BY BOTTOM *) 

13 SEC LDA, BOT X) STA, POPTWO JMP, 

14 

15 DECIMAL ;S 

FORTH INTEREST GROUP 


MAY 1, 1979 



// 33 


;, WFR-79MAR30 ) 

(CREATE NEW COLON-DEFINITION UNTIL *) 

?EXEC !CSP CURRENT (? CONTEXT ! 

CREATE ] ;CODE IMMEDIATE 

IP 1+ LDA, PHA, IP LDA, PHA, CLC, W LDA, 2 # ADC, 

IP STA, TYA, W 1+ ADC, IP 1+ STA, NEXT JMP, 


( TERMINATE COLON-DEFINITION *) 
?CSP COMPILE ;S 

SMUDGE [ ; IMMEDIATE 


#34 

( CONSTANT, VARIABLE, USER WFR-79MAR30 ) 

: CONSTANT ( WORD WHICH LATER CREATES CONSTANTS *) 

CREATE SMUDGE , ;CODE 

i # LDY, W )Y LDA, PHA, INY, W )Y LDA, PUSH JMP, 

: VARIABLE ( WORD WHICH LATER CREATES VARIABLES *) 

CONSTANT ;CODE 

CLC, W LDA, 2 # ADC, PHA, TYA, W 1+ ADC, PUSH JMP, 


: USER ( CREATE 

CONSTANT ;CODE 

2 # LDY, CLC, W )Y LDA, UP ADC, PHA, 
0 If LDA, UP 1+ ADC, PUSH JMP, 


( CREATE USER VARIABLE *) 


#35 

( DEFINED CONSTANTS 
HEX 

00 CONSTANT 0 
02 CONSTANT 2 
20 CONSTANT BL 
40 CONSTANT C/L 


CONSTANT 

CONSTANT 


WFR-78MAR22 


( ASCII BLANK *) 
( TEXT CHARACTERS PER LINE *) 


3BE0 CONSTANT FIRST ( FIRST BYTE RESERVED FOR BUFFERS *) 

4000 CONSTANT LIMIT ( JUST BEYOND TOP OF RAM *) 

80 CONSTANT B/BUF ( BYTES PER DISC BUFFER *) 

8 CONSTANT B/SCR ( BLOCKS PER SCREEN = 1024 B/BUF / *) 


+ORIGIN 


00 +ORIGIN 
LITERAL + 


LEAVES ADDRESS RELATIVE 


ORIGIN 


FORTH INTEREST GROUP 


MAY 1, 1979 



SCR # 36 

0 ( USER VARIABLES 
1 hex ( 0 THRU 


2 

( 06 

USER 

SO ) 

3 

( 08 

USER 

RO ) 

4 

OA 

USER 

TIB 

5 

OC 

USER 

WIDTH 

6 

OE 

USER 

WARNING 

7 

10 

USER 

FENCE 

8 

1 2 

USER 

DP 

9 

14 

USER 

VOC-LINK 

1 0 

16 

USER 

BLK 

1 1 

18 

USER 

IN 

12 

lA 

USER 

OUT 

1 3 

1C 

USER 

SCR 

1 4 

— > 



15 





WFR-78APR2 

5 RESERVED, REFERENCED TO $00A0 
( TOP OF EMPTY COMPUTATION STACK 
( TOP OF EMPTY RETURN STACK 
( TERMINAL INPUT BUFFER 
( MAXIMUM NAME FIELD WIDTH 
( CONTROL WARNING MODES 
( BARRIER FOR FORGETTING 
( DICTIONARY POINTER 
{ TO NEWEST VOCABULARY 
( INTERPRETATION BLOCK 
( OFFSET INTO SOURCE TEXT 
( DISPLAY CURSOR POSITION 
( EDITING SCREEN 


9 ) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 
*) 


SCR # 37 


0 

( 

USER VARIABLES, 

1 

IE 

USER 

OFFSET 

2 

20 

USER 

CONTEXT 

3 

22 

USER 

CURRENT 

4 

24 

USER 

STATE 

5 

26 

USER 

BASE 

6 

28 

USER 

DPL 

7 

2A 

USER 

FLD 

8 

2C 

USER 

CSP 

9 

2E 

USER 

R# 

10 

30 

USER 

HLD 


1 1 —> 
1 2 

13 

14 

15 


CONT. WFR-79APR29 ) 

( POSSIBLY TO OTHER DRIVES *) 
( VOCABULARY FIRST SEARCHED *) 
( SEARCHED SECOND, COMPILED INTO *) 
( COMPILATION STATE *) 
( FOR NUMERIC INPUT-OUTPUT *) 
( DECIMAL POINT LOCATION *) 
( OUTPUT FIELD WIDTH *) 
( CHECK STACK POSITION *) 
( EDITING CURSOR POSITION *) 
( POINTS TO LAST CHARACTER HELD IN PAD *) 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 
13 
1 4 
15 


// 38 

( HI-LEVEL MISC. 


1 + 

2 + 

HERE 

ALLOT 


1 

2 

DP 

DP 


> 

C t 


: < 

; > 

: ROT 
: SPACE 
: -DUP 
--> 


HERE 
HERE 
MINUS 
- 0 = 

- 0 < 
SWAP 
>R 


+ 

+ 

@ 

+! 
2 

C! 

+ 


SWAP R> 
BL EMIT 
DUP IF 


WFR-79APR29 ) 
; (INCREMENT STACK NUMBER BY ONE *) 

; ( INCREMENT STACK NUMBER BY TWO *) 

; ( FETCH NEXT FREE ADDRESS IN DICT. *) 

; ( MOVE DICT. POINTER AHEAD *) 

ALLOT ; . ( ENTER STACK NUMBER TO DICT. *) 

1 ALLOT ; ( ENTER STACK BYTE TO DICT. *) 

( LEAVE DIFF. SEC - BOTTOM *) 
(LEAVE BOOLEAN OF EQUALITY *) 
( LEAVE BOOLEAN OF SEC < BOT *) 

( LEAVE BOOLEAN OF SEC > BOT *) 

SWAP ; { ROTATE THIRD TO BOTTOM *) 

; ( PRINT BLANK ON TERMINAL *) 

DUP ENDIF ; ( DUPLICATE NON-ZERO *) 


FORTH INTEREST GROUP 


MAY 1, 1979 




SCR // 39 

0 ( VARIABLE LENGTH NAME SUPPORT WFR-79MAR30 ) 

1 ; TRAVERSE ( MOVE ACROSS NAME FIELD *) 

2 ( ADDRESS-2, DIRECTION-1, I.E. -1=R TO L, +1=L TO R *) 

3 SWAP 

4 BEGIN OVER + 7F OVER C@ < UNTIL SWAP DROP ; 

6 ; LATEST CURRENT @ @ ; ( NFA OF LATEST WORD *) 

8 

9 ( FOLLOWING HAVE LITERALS DEPENDENT ON COMPUTER WORD SIZE ) 

10 


1 1 : LFA 
12 ; CFA 
13: NFA 

14 ; PFA 

15 —> 


4 - ; 

2 - ; 

5 - -1 TRAVERSE 

1 TRAVERSE 5 + 


( 

CONVERT 

A 

WORDS 

PFA 

TO 

LFA 

*) 

( 

CONVERT 

A 

WORDS 

PFA 

TO 

CFA 

*) 

( 

CONVERT 

A 

WORDS 

PFA 

TO 

NFA 

*) 

( 

CONVERT 

A 

WORDS 

NFA 

TO 

PFA 

*) 


SCR #40 


0 

( 

ERROR 

PROCEEDURES 

, PER SHIRA 



WFR-79MAR23 ) 

1 

2 

• 

• 

! CSP 

SP@ 

CSP 

1 ; ( 

SAVE 

STACK POSITION IN 'CSP' 

*) 

3 


?ERROR 


( 

BOOLEAN-2, 

ERROR 

TYPE-1 . 

WARN FOR TRUE 

*) 

4 

5 



SWAP 

IF 

ERROR 

ELSE DROP 

ENDIF ; 


6 

7 


?COMP 

STATE 

@ 0 

= 11 TERROR 

; ( 

ERROR IF 

NOT COMPILING 

*) 

8 

9 

m 

• 

?EXEC 

STATE 


12 TERROR 

; ( 

ERROR IF 

NOT EXECUTING 

*) 

10 

1 1 

• 

• 

?PAIRS 

- 13 

?ERROR ; ( VERIFY 

STACK VALUES ARE PAIRED 

*) 

1 2 

• 

• 

?CSP 

SP@ CSP @ 

- 14 TERROR ; 

( VERIFY 

STACK POSITION 

*) 

1 3 










14 

m 

• 

’LOADING 



( VERIFY LOADING FROM DISC 

*) 

1 5 



BLK @ 

0= 

16 TERROR 

5 





;cR 

# 

41 


0 

1 

{ 

COMPILE 

, SMUDGE 

2 

; 

COMPILE 


3 

4 


TCOMP R> 

5 

6 


[ 0 

STATE ! 

7 

8 

• 

• 

] CO 

STATE ! 

9 

1 0 

• 

SMUDGE 

LATEST 

1 1 

1 2 


HEX 

10 BASE 

1 3 

: 

DECIMAL 

OA BASE 

1 4 
15 




, HEX, DECIMAL WFR-79APR20 

( COMPILE THE EXECUTION ADDRESS FOLLOWING 
DUP 2+ >R @ ; 

; IMMEDIATE ( STOP COMPILATION 

; ( ENTER COMPILATION STATE 

20 TOGGLE ; ( ALTER LATEST WORD NAME 

J ; ( MAKE HEX THE IN-OUT BASE 

! ; ( MAKE DECIMAL THE IN-OUT BASE 


) 

*) 

*) 

*) 

*) 

*) 

*) 


FORTH INTEREST GROUP 


MAY 1 


1979 




SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
11 
12 

13 

14 

15 


#42 

( ;CODE WFR-79APR20 ) 

: (;CODE) ( WRITE CODE FIELD POINTING TO CALLING ADDRESS *) 

R> LATEST PFA CFA ! ; 


E ( TERMINATE A NEW DEFINING WORD *) 

?CSP COMPILE (;CODE) 

[COMPILE] [ SMUDGE ; IMMEDIATE 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 

13 

14 

15 


# 43 

( <BUILD, DOES> WFR-79MAR20 ) 

; <BUILDS 0 CONSTANT ; ( CREATE HEADER FOR 'DOES>' WORD *) 

s D0ES> ( REWRITE PFA WITH CALLING HI-LEVEL ADDRESS *) 

( REWRITE CFA WITH 'DOES>' CODE *) 
R> LATEST PFA ! ;CODE 

IP 1+ LDA, PHA, IP LDA, PHA, ( BEGIN FORTH NESTING ) 
2 # LDY, W )Y LDA, IP STA, ( FETCH FIRST PARAM ) 

INY, W )Y LDA, IP 1+ STA, ( AS NEXT INTERP. PTR ) 

CLC, W LDA, 4 # ADC, PHA, ( PUSH ADDRESS OF PARAMS ) 
W 1+ LDA, 00 # ADC, PUSH JMP, 

— > 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
1 3 

14 

15 


4 4 

TEXT OUTPUTS WFR-79APR02 ) 
COUNT DUP 1+ SWAP C@ ; ( LEAVE TEXT ADDR. CHAR. COUNT *) 
type ( TYPE STRING FROM ADDRESS-2, CHAR.COUNT-1 *) 


-DUP 

IF OVER + SWAP 




DO I C@ EMIT LOOP ELSE DROP ENDIF 

5 


-TRAILING 

( ADJUST CHAR. COUNT TO DROP TRAILING 

BLANKS 

*) 

DUP 

0 DO OVER OVER + 1 - C@ 



BL - 

IF LEAVE ELSE 1 - ENDIF LOOP 

1 


(.") 

( TYPE IN-LINE STRING, ADJUSTING 

RETURN 

*) 

R COUNT DUP 1+ R> + >R TYPE ; 




2 2 

STATE @ 

(COMPILE OR 

PRINT 

QUOTED STRING *) 

IF COMPILE (.") 

WORD HERE 

c@ 

1+ ALLOT 

ELSE 

WORD 

HERE COUNT 

TYPE 

ENDIF ; 


IMMEDIATE 

--> 




FORTH INTEREST GROUP 


MAY 1, 1979 



WFR-79APR29 ) 


SCR # 45 

0 ( TERMINAL INPUT 
1 

2 : EXPECT ( TERMINAL INPUT MEMORY-2, CHAR LIMIT-!*) 

3 OVER + OVER DO KEY DUP OE +ORIGIN ( BS ) @ = 


4 


IF DROP 08 OVER 

I = DUP 

R> 2 

- + 

>R ■ 

v: — 

5 


ELSE ( NOT BS ) 

DUP OD = 





6 


IF ( RET ) LEAVE DROP 

BL 0 

ELSE 

DUP 

ENDIF 

7 


I C! 0 I 

1+ ! 





8 


ENDIF EMIT LOOP 

DROP ; 





9 

: QUERY TIB @ 50 

EXPECT 0 

IN 1 

• 



10 

8081 

HERE 






1 1 

: X 

BLK (3 


( 

END-OF 

-TEXT 

IS NULL *) 

1 2 


IF ( DISC ) 1 BLK 

+! 0 IN ! 

BLK @ 

7 AND 0= 

1 3 


IF ( SCR END ) 

?EXEC R> 

DROP 

ENDIF 



1 4 


ELSE ( TERMINAL 

) R> DROP 




1 5 


ENDIF ; ! 

IMMEDIATE 

-> 





SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
I I 
12 

13 

14 
15. 


// 

( 


46 

FILL, 

FILL 


ERASE 


BLANKS 


HOLD 


PAD 


— > 


ERASE, BLANKS, HOLD, PAD WFR-79APR02 ) 




( FILL MEMORY BEGIN-3, 

QUAN-2, 

BYTE-l 

SWAP >R OVER C! DUP 

1+ R> 1 

- CMOVE 

\ 

• 

9 


( 

FILL MEMORY 

WITH ZEROS 

BEGIN-2, 

QUAN-1 

0 

FILL ; 

( FILL 

WITH BLANKS 

BEGIN-2, 

QUAN-1 

BL 

FILL ; 







( HOLD 

CHARACTER 

IN PAD 

-1 

ELD +1 

HLD @ C! 

> 




HERE 44 + ; ( PAD IS 68 BYTES ABOVE HERE *) 

( DOWNWARD HAS NUMERIC OUTPUTS; UPWARD MAY HOLD TEXT *) 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
11 
1 2 
1 3 
1 4 
15 


# 47 

( WORD, WFR-79APR02 ) 

5 WORD ( enter WITH DELIMITER, MOVE STRING TO 'HERE' *) 

BLK @ IF BLK @ BLOCK ELSE TIB @ ENDIF 

IN @ + SWAP ( ADDRESS-2, DELIMITER-1 ) 

ENCLOSE ( ADDRESS-4, START-3, END-2, TOTAL COUNT-1 ) 


HERE 22 

BLANKS 



( PREPARE FIELD OF 34 BLANKS ) 

IN +! 


( 

STEP 

OVER THIS STRING ) 

OVER - 

>R 

( 

SAVE 

CHAR COUNT ) 

R HERE 

C 1 

( 

LENGTH STORED FIRST ) 

+ HERE 

1 + 




R> CMOVE 

9 

( 

MOVE 

STRING FROM BUFFER TO HERE+1 ) 


MAY 1, 1979 


FORTH INTEREST GROUP 



SCR it 
0 ( 
1 ; 
2 

3 

4 

5 

6 : 

7 

8 
9 

1 0 
1 1 

12 ; 

13 

14 


48 

(NUMBER-, NUMBER, -FIND, ' WFR-79APR29 ) 

(NUMBER) ( CONVERT DOUBLE NUMBER, LEAVING UNCONV. ADDR. *) 

BEGIN 1+ DUP >R C@ BASE Q DIGIT 

WHILE SWAP BASE (3 U* DROP ROT BASE @ U* D+ 

DPL (3 1+ IF 1 DPL +1 ENDIF R> REPEAT R> ; 

NUMBER ( ENTER W/ STRING ADDR. LEAVE DOUBLE NUMBER *) 

0 0 ROT DUP 1+ C@ 2D = DUP >R + -1 

BEGIN DPL 1 (NUMBER) DUP C@ BL - , 

WHILE DUP C@ 2E - 0 TERROR 0 REPEAT 

DROP R> IF DMINUS ENDIF ; 

-FIND ( RETURN PFA-3, LEN BYTE-2, TRUE-1; ELSE FALSE *) 

BL WORD HERE CONTEXT @ (3 (FIND) 

DUP 0= IF DROP HERE LATEST (FIND) ENDIF ; 


SCR # 

0 ( 

1 

2 : 

3 

4 : 

5 

6 

7 

8 

9 : 
10 
11 

12 — 

13 

14 

15 


49 

ERROR HANDLER WFR-79APR20 ) 

(ABORT) ABORT ; ( USER ALTERABLE ERROR ABORT *) 

error ( WARNING: -l=ABORT, 0=NO DISC, 1=DISC *) 

WARNING (3 0< ( PRINT TEXT LINE REL TO SCR #4 *) 

IF (ABORT) ENDIF HERE COUNT TYPE ? " 

MESSAGE SP! IN (3 BLK @ QUIT ; 

ID. ( PRINT NAME FIELD FROM ITS HEADER ADDRESS *) 

PAD 020 5F FILL DUP PFA LFA OVER - 

PAD SWAP CMOVE PAD COUNT OIF AND TYPE SPACE ; 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 

13 

14 

15 


it 50 

( CREATE 


WFR-79APR28 ) 


create ( A SMUDGED CODE HEADER TO PARAM FIELD *) 

( WARNING IF DUPLICATING A CURRENT NAME. *) 
TIB HERE OAO + < 2 TERROR ( FREE SPACE ? ) 

-FIND ( CHECK IF UNIQUE IN CURRENT AND CONTEXT ) 

IF ( WARN USER ) DROP NFA ID. 

MESSAGE SPACE ENDIF 
@ MIN 1+ ALLOT 


--> 


4 

HERE DUP C@ WIDTH 
DP C@ OFD = ALLOT 
DUP AO TOGGLE HERE 
LATEST , CURRENT (3 
HERE 2+ . ; 


1 - 80 TOGGLE ( DELIMIT BITS ) 


FORTH INTEREST GROUP 


MAY 1, 1979 



SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 
1 3 

14 

15 


5 1 


LITERAL, 

DLITERAL, [COMPILE], 7STACK 

WFR-79APR29 ) 

[COMPILE] 

-FIND 

0 = 

0 

( FORCE COMPILATION OF AN 
?ERROR DROP CFA , ; 

IMM^EDIATE WORD *) 
IMMEDIATE 

LITERAL 

STATE 

@ 

IF 

( IF COMPILING, 
COMPILE LIT , ENDIF ; 

CREATE LITERAL *) 
IMMEDIATE 

DLITERAL 

STATE 


IF 

( IF COMPILING, CREATE 
SWAP [COMPILE] LITERAL 
[COMPILE] LITERAL 

DOUBLE LITERAL *) 

ENDIF ; IMMEDIATE 


FOLLOWING DEFINITION IS INSTALLATION DEPENDENT ) 

?STACK ( QUESTION UPON OVER OR UNDERFLOW OF STACK *) 
09E SP@ < 1 TERROR SP@ 020 < 7 TERROR ; 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 
1 3 

14 

15 


52 

INTERPRET, 


WFR-79APR18 ) 

\ 

OR COMPILE SOURCE TEXT INPUT WORDS *) 


INTERPRET ( INTERPRET 
BEGIN -FIND 

IF ( FOUND ) STATE @ < 

IF CFA , ELSE CFA EXECUTE 
ELSE HERE NUMBER DPL (§ 1 + 

IF [COMPILE] DLITERAL 

ELSE DROP [COMPILE] LITERAL 

ENDIF AGAIN ; 


— > 


ENDIF TSTACK 


ENDIF TSTACK 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 
1 3 
14 
1 5 


# 5 3 

( IMMEDIATE, VOCAB, DEFIN, FORTH, ( DJK-WFR-79APR29 ) 

: IMMEDIATE ( TOGGLE PREC. BIT OF LATEST CURRENT WORD *) 

LATEST 40 TOGGLE ; 

; VOCABULARY ( CREATE VOCAB WITH 'V-HEAD' AT VOC INTERSECT. *) 


<BUILDS A081 


CURRENT @ CFA 


HERE VOC-LINK @ , VOC-LINK 

DOES> 2+ CONTEXT • ; 


VOCABULARY FORTH 


IMMEDIATE 


( THE TRUNK VOCABULARY *) 


: DEFINITIONS ( SET THE CONTEXT ALSO AS CURRENT VOCAB *) 

CONTEXT @ CURRENT ! ; 

' ^ ( SKIP INPUT TEXT UNTIL RIGHT PARENTHESIS *) 

29 WORD ; IMMEDIATE —> 


FORTH INTEREST GROUP 


MAY 1, 1979 



#54 

{ QUIT, ABORT 


WFR-79MAR30 ) 


• ( RESTART, INTERPRET FROM TERMINAL *) 

0 BLK ! (COMPILE] [ 

BEGIN RPl CR QUERY INTERPRET 

STATE @0= IF OK" ENDIF AGAIN ; 

: ABORT ( WARM RESTART, INCLUDING REGISTERS *) 

SP( DECIMAL DRO 

CR ." FORTH-65 V 4.0" 

[COMPILE] FORTH DEFINITIONS QUIT ; 


SCR # 55 

0 ( COLD START 

1 CODE COLD 

2 HERE 02 +ORIGIN 

3 OC +ORIGIN 

4 OD +ORIGIN 

5 15 # LDY, ( 

6 HERE 06 +ORIGIN 

7 OF # LDY, ( I 

8 10 +ORIGIN LDA 

9 11 +ORIGIN LDA 

10 BEGIN, OC +0 

1 1 

12 DEY, 0< 

13 'T ABORT 100 


6C # LDA, W 1 


( C 
! ( 
LDA, 
LDA, 
INDEX 
! ( 
NDEX TO 
, . OP 
, UP 
RIGIN , 
UP ) 
END, 
/MOD # 
# 

- STA, 


WFR-79APR29 ) 
:OLD START, INITIALIZING USER AREA *) 
POINT COLD ENTRY TO HERE ) 

T FORTH 4 + STA, ( FORTH VOCAB. ) 

T FORTH 5 + STA, 

TO VOC-LINK ) 0= IF, ( FORCED ) 

POINT RE-ENTRY TO HERE ) 

' WARNING ) THEN, ( FROM IF, ) 

STA, ( LOAD UP ) 

1+ STA, 

Y LDA, ( FROM LITERAL AREA ) 

Y STA, ( TO USER AREA ) 

LDA, IP 1+ STA, 

LDA, IP STA, 

'T RPl JMP, ( RUN ) —> 


# 5 6 

( MATH UTILITY DJK-WFR-79APR29 ) 

CODE S->D ( EXTEND SINGLE INTEGER TO DOUBLE *) 

BOT 1+ LDA, 0< IF, DEY, THEN, TYA, PHA, PUSH JMP, 


+ — 

0< IF 

MINUS 

ENDIF 

; ( APPLY SIGN TO 

D + - 



( 

APPLY SIGN TO DOUBLE 


0< IF 

DMINUS ENDIF ; 

ABS 

DUP 

4— 

1 

( LEAVE 

DABS 

DUP 

D-f- 

5 

( DOUBLE INTEGER 

MIN 




( LEAVE SMALLER 


OVER 

OVER 

> IF 

SWAP ENDIF DROP 

MAX 




( LEAVE LARGET 


OVER 

OVER 

< IF 

SWAP ENDIF DROP 


FORTHTNTERESTGROUP 


MAY 1, 1979 



57 

MATH 

M* 


/MOD 

/ 

MOD 

*/MOD 

*/ 

M/MOD 


PACKAGE DJK-WFR-79APR29 ) 

( LEAVE SIGNED DOUBLE PRODUCT OF TWO SINGLE NUMBERS *) 
'ER OVER XOR >R ABS SWAP ABS U* R> D+- 

( FROM SIGNED DOUBLE-3-2, SIGNED DIVISOR-l *) 
(LEAVE SIGNED REMAINDER-2, SIGNED QUOTIENT-l *) 
ER >R >R DABS R ABS U/ 

R XOR +- SWAP R> +- SWAP ; 

* DROP ; ( SIGNED PRODUCT *) 

R S->D R> M/ ; ( LEAVE REM-2, QUOT-1 *) 

MOD SWAP DROP ; ( LEAVE QUOTIENT *). 

MOD DROP ; ( LEAVE REMAINDER *) 

( TAKE RATION OF THREE NUMBERS, LEAVING *) 
R M* R> M/ ; ( REM-2, QUOTIENT-1 *) 

/MOD SWAP DROP ; (LEAVE RATIO OF THREE NUMBS *) 

( DOUBLE, SINGLE DIVISOR ... REMAINDER, DOUBLE *) 

>R 0 R U/ R> SWAP >R U/ R> ; —> 


OVER OVER XOR >R 

( FROM SIGN 
(LEAVE SIGNED 
OVER >R >R DABS R 
R> R XOR +- SWAP 

U* DROP ; 

>R S->D R> M/ ; 


/MOD 

/MOD 

>R M* 
*/MOD 


SWAP 

DROP 

' R> 
SWAP 


DROP 


# 5 8 

( DISC UTILITY, GENERAL USE WFR—79APR02 ) 

FIRST VARIABLE USE ( NEXT BUFFER TO USE, STALEST *) 

FIRST VARIABLE PREV ( MOST RECENTLY REFERENCED BUFFER *) 

; +BUF ( ADVANCE ADDRESS-1 TO NEXT BUFFER. RETURNS FALSE *) 

84 ( I.E. B/BUF+4 ) + DUP LIMIT = ( IF AT PREV *) 

IF DROP FIRST ENDIF DUP PREV (3 _ ; 

: UPDATE ( MARK THE BUFFER POINTED TO BY PREV AS ALTERED *) 

PREV @ @ 8000 OR PREV @ ! ; 

; EMPTY-BUFFERS ( CLEAR BLOCK BUFFERS; DON'T WRITE TO DISC *V 
FIRST LIMIT OVER - ERASE ; 


: DRO 0 OFFSET 1 ; 

: DRl 07D0 OFFSET ! ; _> 


( SELECT DRIVE #0 *) 
( SELECT DRIVE #1 *) 


59 

BUFFER 
BUFFER 
USE @ 
BEGIN 


@ 0 
r ( UP 
R 2 
R (3 
0 

ENDIF 
1 ( 
PREV 
> 2 + 


WFR-79APR02 ) 

( CONVERT BLOCK// TO STORAGE ADDRESS *) 
DUP >R ( BUFFER ADDRESS TO BE ASSIGNED ) 

+BUF UNTIL ( AVOID PREV ) USE ! ( FOR NEXT TIME ) 

K ( TEST FOR UPDATE IN THIS BUFFER ) 


0< ( TEST FOR UPDATE 

UPDATED, FLUSH TO DISC 
2+ ( STORAGE LOG. ) 


7FFF AND 
R/W 


( ITS BLOCK // ) 
( WRITE SECTOR 


WRITE NEW BLOCK if 
I ( ASSIGN THIS 
( MOVE TO STORAGE 


INTO THIS 
BUFFER AS 
LOCATION 


TO DISC 

BUFFER : 
'PREV' 


FORTH INTEREST GROUP 


MAY 1, 1979 



CONVERT BLOCK 
( RETAIN 
- DUP 


SCR # 60 

0 ( BLOCK 

1 BLOCK ( 

2 OFFSET (3 + >R 

3 PREV @ DUP (a R - 

4 IF ( NOT PREV ) 

5 BEGIN +BUF 0= ( 

6 IF ( WRAPPED ) 

7 DUP R 1 

8 2 - ( BACKUP 

9 END IF 

10 DUP (3 R - DUP 

11 UNTIL ( WITH BUFFER 

12 DUP PREV ! 

13 ENDIF 

14 R> DROP 2+ ; 

15 —> 


WFR-79APR02 ) 
NUMBER TO ITS BUFFER ADDRESS *) 
BLOCK // ON RETURN STACK ) 

+ ( BLOCK = PREV ? ) 


TRUE 

DROP 

) 


UPON REACHING 
R BUFFER 
R/W 


PREV' ) 


( READ SECTOR FROM DISC ) 


+ 0 = 
ADDRESS 


SCR // 61 

0 ( TEXT OUTPUT FORMATTING WFR-79MAY03 ) 

2 : (LINE) ( LINE//, SCR#, ... BUFFER ADDRESS, 64 COUNT *) 

3 >R C/L B/BUF */MOD R> B/SCR * + 

4 BLOCK + C/L 

5 

6 : .LINE ( LINE#, SCR#, ... PRINTED *) 

7 (LINE) -TRAILING TYPE ; 

8 

9 ; MESSAGE (PRINT LINE RELATIVE TO SCREEN #4 OF DRIVE 0 *) 

10 WARNING @ 

11 IF (DISC IS AVAILABLE ) 

12 -DUP IF 4 OFFSET @ B/SCR / - .LINE ENDIF 

13 ELSE .” MSG # " . ENDIF ; 

14 --> 

15 


SCR # 62 

0 ( LOAD, —> 

1 

2 : LOAD 

3 BLK @ >R IN @ 

4 INTERPRET R> IN 

5 

6 : --> ( 

7 7LOADING 0 IN 

8 MOD - BLK +! 

9 

10 —> 

1 1 


WFR-79APR02 ) 

( INTERPRET SCREENS FROM DISC *) 
>R 0 IN ! B/SCR * BLK ! 

! R> BLK ! ; 

CONTINUE INTERPRETATION ON NEXT SCREEN *) 
! B/SCR BLK @ OVER 
; IMMEDIATE 


1 2 

13 

14 
1 5 


FORTH INTEREST GROUP 


MAY 1, 1979 



TIM 


WFR-79APR26 ) 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 
1 3 
1 4 
1 5 


#63 

( INSTALLATION DEPENDENT TERMINAL I-O 
( emit ) ASSEMBLER 

HERE -2 BYTE.IN EMIT ! 

XSAVE STX, BOT LDA, 7F # 


CLC 


( KEY ) 


lA # 


LDY, 

INY, 


UP 

UP 


)Y 

)Y 


LDA, 

LDA, 


( VECTOR EMITS' CF TO HERE ) 
AND, 72C6 JSR, XSAVE LDX, 

01 ADC, UP )Y ST A, 

00 // ADC, UP )Y STA, POP JMP. 


HERE -2 BYTE.IN 
XSAVE STX, BEGIN, 
BEGIN, 6E02 LDA, 
BEGIN, 731D JSR, 

0 X) CMP, 0 X) CMP, 


.A LSR, PLP, CS IF 
0= END, 731D JSR, 
XSAVE LDX, PUSHOA 


KEY 1 
8 // LDX 
.A LSR, 

OX) CMP, 0 
6E02 LDA, 


( AND INCREMENT 'OUT' ) 
( VECTOR KEYS' CF TO HERE ) 


CS END 


7320 JSR 


X) CMP, 
.A LSR, 
, 80 // ORA, THEN, 

FF If EOR, 7F # AND, 
JMP, —> 


0 X) CMP, 
PHP, TYA, 
TAY, DEX, 

0= NOT END, 


SCR # 64 

0 ( INSTALLATION DEPENDENT TERMINAL I-O, TIM WFR-79APR02 ) 

1 

2 ( 7TERMINAL ) 

3 HERE -2 BYTE.IN 7TERMINAL ! ( VECTOR LIKEWISE ) 

4 1 If LDA, 6E02 BIT, 0= NOT IF, 

5 BEGIN, 73ID JSR, 6E02 BIT, 0= END, INY, THEN, 

6 TYA, PUSHOA JMP, 

7 

8 ( CR ) 

9 HERE -2 BYTE.IN CR 1 ( VECTOR CRS' CF TO HERE ) 

10 XSAVE STX, 728A JSR, XSAVE LDX, NEXT JMP, 

1 1 

1 2 —> 

13 

14 

15 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
1 2 
1 3 

14 

15 


If 65 

( INSTALLATION 
6900 CONSTANT 
6901 CONSTANT 


#HL 


0 OA U/ 




DEPENDENT DISC 
DATA 
STATUS 


( CONVERT DECIMAL D 
SWAP 30 + HOLD 


IG 


IT 


WFR-79APR02 ) 
( CONTROLIER PORT *) 

( CONTROLLER PORT *) 


FOR DISC CONTROLLER *) 


FORTH INTEREST GROUP 


MAY 1, 1979 



// 6 6 
( D 
CODE 


’/char, ?DISC, WFR-79MAR23 ) 

: D/CHAR ( TEST CHAR-1. EXIT TEST BOOL-2, NEW CHAR-1 *) 
DEX, DEX, BOT 1+ STY, CO if LDA, 
iEGIN, STATUS BIT, 0= NOT END, ( TILL CONTROL READY ) 

DATA LDA, BOT STA, ( SAVE CHAR ) 

SEC CMP, 0* IF, INY, THEN, SEC STY, NEXT JMP, 

’^SC ( UPON NAK SHOW ERR MSG, QUIT. ABSORBS TILL *) 

1 D/CHAR >R 0= ( EOT, EXCEPT FOR SOH *) 

IF ( NOT SOH ) R 15 = 

IF ( NAK ) CR 

BEGIN A D/CHAR EMIT 

UNTIL ( PRINT ERR MSG TIL EOT ) QUIT 
ENDIF ( FOR ENQ, ACK ) 

BEGIN A D/CHAR DROP UNTIL ( AT EOT ) 

ENDIF R> DROP ; —> 


if 6 7 

( BLOCK-WRITE WFR-790103 ) 

CODE BLOCK-WRITE ( SEND TO DISC FROM ADDRESS-2, COUNT-1 *) 

2 if LDA, SETUP JSR, (WITH EOT AT END *) 

BEGIN, 0 2 if LDA, 

BEGIN, STATUS BIT, 0« END, (TILL IDLE ) 

N CPY, 0= 

IF, ( DONE ) OA if LDA, STATUS STA, DATA STA, 

NEXT JMP, 

THEN, 

N 2+ )Y LDA, DATA STA, INY, 

0= END, ( FORCED TO BEGIN ) 


if 68 

( BLOCK-READ, 

CODE BLOCK-READ ( BUF.ADDR-1. EXIT AT 12 
1 if LDA, SETUP JSR, 

BEGIN, CO if LDA, 

BEGIN, STATUS BIT, 0= NOT END, 

50 ( BVC, D6=DATA ) 

IF, DATA LDA, N )Y STA, INY, 

0< END, ( LOOP TILL 128 BYTES ) 
THEN, ( OR D6=0, SO D7=l, ) 

NEXT JMP, 


WFR-790103 ) 

EXIT AT 128 CHAR OR CONTROL *) 


NOT END, ( TILL FLAG ) 


SWAP 


FORTH INTEREST GROUP 


MAY 1, 1979 



SCR # 69 

0 ( R/W FOR PERSCI 1070 CONTROLLER WFR-79MAY03 ) 

1 OA ALLOT HERE ( WORKSPACE TO PREPARE DISC CONTROL TEXT ) 


2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
1 3 
1 4 
1 5 


( IN FORM; C TT SS /D, TT=TRACK, SS=SECTOR, D=DRIVE ) 

( C = I TO READ, 0 TO WRITE *) 

: R/W ( READ/WRITE DISC BLOCK *) 

( BUFFER ADDRESS-3, BLOCK #-2, 1=READ 0»WRITE *) 
LITERAL HLD ! ( JUST AFTER WORKSPACE ) SWAP 

0 OVER > OVER 0F9F > OR 6 TERROR 

07D0 ( 2000 SECT/DR ) /MOD #HL DROP 2F HOLD BL HOLD 

lA /MOD SWAP 1+ #HL #HL DROP BL HOLD ( SECTOR 01-26 ) 

#HL #HL DROP BL HOLD ( TRACK 00-76 ) 

DUP 

IF 49 ( I»READ) ELSE 4F ( 0=WRITE ) ENDIF 

HOLD HLD @ OA BLOCK-WRITE ( SEND TEXT ) ?DISC 

IF BLOCK-READ ELSE B/BUF BLOCK-WRITE ENDIF 
?DISC ; —> 


SCR 

if 

70 




0 

( 

FORWARD 

REFERENCES 



1 

00 

BYTE.IN 

• 

• 

REPLACED.BY 

?EXEC 

2 

02 

BYTE.IN 

• ' 

REPLACED.BY 

ICSP 

3 

04 

BYTE.IN 

• 

• 

REPLACED.BY 

CURRENT 

4 

08 

BYTE.IN 

• 

REPLACED.BY 

CONTEXT 

5 

OC 

BYTE.IN 


REPLACED.BY 

CREATE 

6 

OE 

BYTE.IN 

: 

REPLACED.BY 

] 

7 

10 

BYTE.IN 

• 

• 

REPLACED.BY 

(;CODE) 

8 

00 

BYTE.IN 

• 

9 

REPLACED.BY 

?CSP 

9 

02 

BYTE.IN 

9 

REPLACED.BY 

COMPILE 

10 

06 

BYTE.IN 

9 

REPLACED.BY 

SMUDGE 

1 1 

08 

BYTE.IN 

5 

REPLACED.BY 

[ 

1 2 

00 

BYTE.IN 

CONSTANT 

REPLACED.BY 

CREATE 

1 3 

0 2 

BYTE.IN 

CONSTANT 

REPLACED.BY 

SMUDGE 

1 4 

04 

BYTE.IN 

CONSTANT 

REPLACED.BY 


1 5 

06 

BYTE.IN 

CONSTANT 

REPLACED.BY 

(;CODE) 

SCR 

if ■ 

71 




0 

( 

FORWARD REFERENCES 



1 

02 

BYTE.IN 

VARIABLE 

REPLACED.BY 

(;CODE) 

2 

02 

BYTE.IN 

USER 

REPLACED.BY 

(;CODE) 

3 

06 

BYTE.IN 

7ERROR 

REPLACED.BY 

ERROR 

4 

OF 

BYTE.IN 

11 

• 

REPLACED.BY 

WORD 

5 

ID 

BYTE.IN 

ff 

• 

REPLACED.BY 

WORD 

6 

00 

BYTE.IN 

(ABORT) 

REPLACED.BY 

ABORT 

7 

19 

BYTE.IN 

ERROR 

REPLACED.BY 

MESSAGE 

8 

25 

BYTE.IN 

ERROR 

REPLACED.BY 

QUIT 

9 

OC 

BYTE.IN 

WORD 

REPLACED.BY 

BLOCK 

1 0 

IE 

BYTE.IN 

CREATE 

REPLACED.BY 

MESSAGE 

1 1 

2C 

BYTE.IN 

CREATE 

REPLACED.BY 

MIN 

1 2 

04 

BYTE.IN 

ABORT 

REPLACED.BY 

DRO 

1 3 

2C 

BYTE.IN 

BUFFER 

REPLACED.BY 

R/W 

1 4 

1 5 

30 

BYTE.IN 

BLOCK 

REPLACED.BY 

R/W 


WFR-79MAR30 ) 


— > 


WFR-79APR29 ) 


DECIMAL ;S 


FORTH INTEREST GROUP 


MAY 1, 1979 




#72 

( ', FORGET, \ WFR-79APR28 ) 

HEX 3 WIDTH ! 

•• ' ( find next words PFA; COMPILE IT, IF COMPILING *) 

-FIND 0= 0 TERROR DROP [COMPILE] LITERAL ; , 

IMMEDIATE 


FORGET (FOLLOWING WORD FROM CURRENT VOCABULARY *) 

CURRENT @ CONTEXT @ - 18 TERROR 

[COMPILE] ' DUP FENCE @ < 15 TERROR 

DUP NFA DP ! LFA (? CURRENT @ ! ; 


IMMEDIATE 


TCOMP 2 TPAIRS HERE OVER - SWAP ! ; IMMEDIATE 


SCR # 73 

0 ( CONDITIONAL COMPILER, PER SHIRA WFR-79APR01 ) 

1 ; BACK HERE - , ; ( RESOLVE BACKWARD BRANCH *) 

2 

3 : BEGIN TCOMP HERE 1 ; IMMEDIATE 

4 

5 : ENDIF TCOMP 2 TPAIRS HERE OVER - SWAP ! : IMMEDIATE 

6 

7 : THEN [COMPILE] ENDIF ; IMMEDIATE 

8 

9 : DO COMPILE (DO) HERE 3 ; IMMEDIATE 

10 

11 ; LOOP 3 TPAIRS COMPILE (LOOP) BACK ; IMMEDIATE 

12 

13 : +LOOP 3 TPAIRS COMPILE (+LOOP) BACK ; IMMEDIATE 

15 : UNTIL 1 TPAIRS COMPILE OBRANCH RATlf ? TMMFntATir _ -s 


BEGIN 


ENDIF 


THEN 


[COMPILE] ENDIF ; IMMEDIATE 
COMPILE (DO) HERE 3 ; 


IMMEDIATE 


3 TPAIRS COMPILE (LOOP) BACK ; IMMEDIATE 


3 TPAIRS COMPILE (+LOOP) BACK ; 


IMMEDIATE 


1 TPAIRS COMPILE OBRANCH BACK ; IMMEDIATE ■—> 


SCR # 74 

0 ( CONDITIONAL COMPILER 

1 : end [COMPILE] UNTIL ; IMMEDIATE 


2 

3 ; AG 

4 

5 : RE 

6 

7 

8 : IF 


AGAIN 


10 : ELSE 
1 1 


1 TPAIRS COMPILE BRANCH BACK 


REPEAT >R >R [COMPILE] AGAIN 

R> R> 2 - [COMPILE] ENDIF 


WFR-79APR01 ) 


IMMEDIATE 


IMMEDIATE 


COMPILE OBRANCH HERE 0,2; IMMEDIATE 

2 TPAIRS COMPILE BRANCH HERE 0 , 

SWAP 2 [COMPILE] ENDIF 2 ; IMMEDIATE 


13 : WHILE [COMPILE] IF 2+ ; 

14 

15 --> 


IMMEDIATE 


FORTH INTEREST GROUP 


MAY 1, 1979 



SCR // 7 5 

? ? WFR-79APR01 ) 

^ . SPACES 0 MAX -DUP IF 0 DO SPACE LOOP ENDIF ; 

3 : <// PAD HLD ' ; 

4 

5 ; DROP DROP HLD @ PAD OVER - ; 

6 ^ 

7 : SIGN ROT 0< IF 2D HOLD ENDIF ; 

8 

( CONVERT ONE DIGIT, HOLDING IN PAD * ) 
jO BASE (3 M/MOD ROT 9 OVER < IF 7 + ENDIF 30 + HOLD ; 

12 ; ifS BEGIN # OVER OVER OR 0= UNTIL • 

14 

15 


BEGIN # OVER OVER OR 0= UNTIL 


SCR # 76 

0 ( OUTPUT OPERATORS 


1 : D.R 

2 

3 

4 

5 : D. 

6 

7 : .R 

8 

9 ; . 

10 

11 : ? 

1 2 

13 ' . 

14 —> 

1 5 


WFR-79APR20 ) 


( DOUBLE INTEGER OUTPUT, RIGHT ALIGNED IN FIELD *) 
>R SWAP OVER DABS <// //S SIGN //> 

R> OVER - SPACES TYPE ; 


0 D.R SPACE ; 
>R S->D R> D.R 
S->D D. ; 

@ . ; 


( DOUBLE INTEGER OUTPUT *) 
( ALIGNED SINGLE INTEGER *) 
( SINGLE INTEGER OUTPUT *) 
( PRINT CONTENTS OF MEMORY *) 


^ MESSAGE 2A + ! ( PRINT MESSAGE NUMBER ) 


SCR // 7 7 

? DOCUMEHTAIIOII WFR-79APE20 ) 

i HEX 

I ' ( LIST SCREEN BY NUMBER ON STACK *) 

3 DECIMAL CR DUP SCR ! 

J •" SCR # " . 10 0 DO CR I 3 .R SPACE 

5 I SCR @ .LINE LOOP CR ; 


LIST 


INDEX 


TRIAD 


^ ( PRINT FIRST LINE OF EACH SCREEN FROM-2, TO-1 *) 

OC EMIT ( FORM FEED ) CR 1+ SWAP 
DO CR I 3 .R SPACE 
0 I .LINE 

7TERMINAL IF LEAVE ENDIF LOOP ; 

( PRINT 3 SCREENS ON PAGE, CONTAINING # ON STACK *) 
OC EMIT ( FF ) 3 / 3 * 3 OVER + SWAP 

DO CR I LIST LOOP CR 

OF MESSAGE CR ; DECIMAL —> 


FORTH INTEREST GROUP 


MAY 1, 1979 





SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 
1 3 

14 

15 


It 7 8 

( TOOLS 
HEX 

: VLIST 

BEGIN 



WFR-79APR20 ) 

( LIST CONTEXT VOCABULARY *) 
80 OUT ! CONTEXT @0 
OUT 0 C/L > IF CR 0 OUT ! ENDIF 
DUP ID. SPACE SPACE PFA LFA 0 
DUP 0= 7TERMINAL OR UNTIL DROP ; 


SCR 

0 

1 

2 

3 

4 

5 

6 

7 

8 
9 


0 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 
1 1 
12 

13 

14 

15 


it 7 9 

( TOOLS 
HEX 

CREATE MON 

0 C, 


4C C, 


WFR-79MAY03 ) 


( CALL MONITOR, SAVING RE-ENTRY TO FORTH *) 


LIT 18 + 


SMUDGE 


10 

DECIMAL 





11 

HERE 


FENCE 

J 


12 

HERE 

28 

+ORIGIN 

[ 

( COLD START FENCE ) 

1 3 

HERE 

30 

+ORIGIN 

t 

( COLD START DP ) 

14 

LATEST 

12 

+ORIGIN 

1 

( TOPMOST WORD ) 

1 5 

' FORTH 

6 + 

32 +ORIGIN 

! ( COLD VOC-LINK 

SCR 

00 

o 






;s 


• -> 


FORTH INTEREST GROUP 


MAY 1, 1979 



Thu is a sample editor, compatable with the fig-FORTH model and simple terminal 
devices. The line and screen editing functions are portable. The code definition 
for the string MATCH could be written high level or translated. 


SCR # 87 

0 ( TEXT, LINE 

1 FORTH DEFINITIONS HEX 

2 ; TEXT 

3 HERE C/L 1+ BLA 

5 ; LINE (RE 

6 DUP FFFO AND 17 

7 SCR @ (LINE) DR 

8 --> 

9 

10 
1 1 
12 

13 

14 

15 


XI, LINE WFR-79MAY01 ) 

DEFINITIONS HEX 

T ( ACCEPT FOLLOWING TEXT TO PAD *) 

HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ; 

E (RELATIVE TO SCR, LEAVE ADDRESS OF LINE *) 

DUP FFFO AND 17 7ERROR ( KEEP ON THIS SCREEN ) 

SCR @ (LINE) DROP ; 


SCR /A 8 8 

0 ( LINE EDITOR WFR-79MAY03 ) 

1 VOCABULARY EDITOR IMMEDIATE HEX 

2 : WHERE (PRINT SCREEN # AND IMAGE OF ERROR *) 

3 DUP B/SCR / DUP SCR ! ."SCR # " DECIMAL . 

4 SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE 

5 CR HERE C(a - SPACES 5E EMIT [COMPILE] EDITOR QUIT ; 


7 

EDITOR 

DEFINITIONS 





8 

: //LOCATE 

( LEAVE CURSOR OFFSET 

-2, 

LINE-l 

*) 

9 

; //LEAD 

R# @ C/L 

/MOD ; 



10 


( LINE ADDRESS-2, OFFSET-1 

TO 

CURSOR 

*) 

1 1 


//LOCATE LINE SWAP ; 


1 2 

: //LAG 


( CURSOR ADDRESS-2, COUNT-1 AFTER 

CURSOR 

*) 

13 


#LEAD DUP 

>R + C/L R> - ; 



14 

: -MOVE 

( MOVE 

IN BLOCK BUFFER ADDR FROM-2, 

LINE TO-1 

*) 

1 5 


LINE C/L 

CMOVE UPDATE ; --> 




SCR J 8 9 

0 ( LINE EDITING COMMANDS WFR—79MAY03 ) 

^ ® ( HOLD NUMBERED LINE AT PAD *) 

2 LINE PAD 1+ C/L DUP PAD C! CMOVE ; 


2 

3 

4 : E 

5 

6 

7 ; S 

8 
9 

10 

11 : D 


LINE C/L BLANKS UPDATE ; 


( ERASE LINE-1 WITH BLANKS *) 


( SPREAD MAKING LINE if BLANK *) 
DUP 1 - ( LIMIT ) OE ( FIRST TO MOVE ) 

DO I LINE I 1+ -MOVE -1 +LOOP E ; 

(DELETE LINE-1, BUT HOLD IN PAD *) 

DUP H OF DUP ROT 

DO I 1+ LINE I -MOVE LOOP E ; 


FORTH INTEREST GROUP 
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// 90 

( LINE EDITING COMMANDS 


WFR-79MAY03 ) 


( MOVE CURSOR BY SIGNED AMOUNT-1, PRINT ITS LINE *) 
R// +1 CR SPACE //LEAD TYPE 5F EMIT 

//LAG TYPE //LOCATE . DROP ; 

( TYPE LINE BY //-I, SAVE ALSO IN PAD *) 

DUP C/L * Rif ! DUP H 0 M ; 

( RE-LIST SCREEN *) 

SCR @ LIST 0 M ; 


SCR // 91 

0 ( LINE EDITING COMMANDS WFR—790105 ) 

^ ^ ( REPLACE ON LINE //-I, FROM PAD *) 

2 PAD 1+ SWAP -MOVE ; 

3 

t ‘ ^ ( PUT FOLLOWING TEXT ON LINE-1 *) 

5 1 TEXT R ; 

6 

^ ^ ( INSERT TEXT FROM PAD ONTO LINE // *) 

8 DUP S R ; ■ 

9 ^ CR 

10 ; TOP ^ ^ ( HOME CURSOR TO TOP LEFT OF SCREEN *) 

12 --> 

13 

14 

15 


if 9 2 

( SCREEN EDITING COMMANDS 
: CLEAR 

SCR ! 10 0 DO FORTH 


WFR-79APR27 ) 
( CLEAR SCREEN BY NUMBER-l *) 
EDITOR E LOOP : 


PUUSH (WRITE ALL UPDATED BLOCKS TO DISC *) 

[ LIMIT FIRST - B/BUF 4 + / ] (NUMBER OF BUFFERS) 
LITERAL 0 DO 7FFF BUFFER DROP LOOP ; 


( duplicate screen-2, ONTO SCREEN-1 *) 
B/SCR * OFFSET (3 + SWAP B/SCR * B/SCR OVER + SWAP 

DO DUP FORTH I BLOCK 2 - I 1+ UPDATE LOOP 

DROP FLUSH ; 


FORTH INTEREST GROUP 


MAY 1, 1979 



SCR // 9 3 

0 ( STRING EDITING PRIMITIVES 

1 CODE MATCH ( CURSOR ADDRESS-4, BYTES 

2 (ITS COUNT-l. LEAVE BOOLEAN-2, 


WFR-79APR22 ) 
LEFT-3, STRING ADDR-2 *) 
CURSOR ADVANCEMENT-I *) 


3 

4 // 

LDA, 

SETUP JSR, 

DEX, 

DEX, DEX, 

DEX, 


4 

BOT 

STY , 

BOT 1+ STY 

$ 




5 

BEGIN 

. ( 

NEW MATCH ) 

DROP 

( ERR ) FF 

// LDY, 


6 

BEGIN, 

DROP ( ERR ) 

INY, 

N CPY, CS 

NOT 


7 


IF , 

( Y < STRING 

) N 

2+ )Y LDA, N 

6 + )Y CMP, 


8 

ROT 1 


NOT UNTIL, 

( REPEAT FOR GOOD 

MATCH ) 


9 


N 

6 + INC, 

0= IF, 

N 7 + INC, 

ENDIF, 


10 


BOT INC, 

0= IF, 

BOT 1+ INC, 

ENDIF, ( CUR 

MOT 

1 1 


N 

4 + LDA, 

0= IF, 

N 5 + DEC, 

ENDIF, 


1 2 



N 4 + DEC, 

( 

DECREMENT BUFFER REMAINING ) 


1 3 


N 

4 + LDA, N 

CMP , 

( REMAINING 

- STRING SIZE 

) 

14 



N 5 + LDA, 

N 1 + 

SBC, 




15 ROT 1 


CS NOT UNTIL, 


— > 


( REFT TILL OUT OF BUFFER ) 


SCR 9 4 

0 ( CONCLUSION OF STRING MATCH WFR-79APR22 ) 

1 0 # LDA, SEC STA, SEC 1+ STA, ( BOOLEAN FALSE ) 

2 N 4 + LDY, ( SPACE UNTIL END OF BUFFER ) 

3 END IF, 

4 CLC, TYA, BOT ADC, PHA, 

5 0 # LDA, BOT 1+ ADC, (ADJUST CURSOR MOTION ) 

6 PUT JMP, C; 

7 —> 

8 
9 

10 
11 
12 

13 

14 

15 


SCR # 95 

0 ( STRING EDITING COMMANDS WFR-79MAR24 ) 

1 : ILINE ( SCAN LINE WITH CURSOR FOR MATCH TO PAD TEXT, *) 

2 ( UPDATE CURSOR, RETURN BOOLEAN *) 

3 //LAG PAD COUNT MATCH R// +! ; 

4 ■ 

5 : FIND ( STRING AT PAD OVER FULL SCREEN RANGE, ELSE ERROR*) 

6 BEGIN 3FF R// (? < 

7 IF TOP PAD HERE C/L 1+ CMOVE 0 ERROR ENDIF 

8 ILINE UNTIL ; 

9 ■ 

10 : DELETE (BACKWARDS AT CURSOR BY COUNT-l *) 

11 >R //LAG + FORTH R - ( SAVE BLANK FILL LOCATION ) 

12 //LAG R MINUS R// +! ( BACKUP CURSOR ) 

13 //LEAD + SWAP CMOVE 

14 R> BLANKS UPDATE ; ( FILL FROM END OF TEXT ) 

1 5 --> 

FORTH INTEREST GROUP MAY 1, 1979 



SCR # 96 

0 (STRING EDITOR COMMANDS WFR-79MAR24 ) 

1 : N ( FIND NEXT OCCURANCE OF PREVIOUS TEXT *) 

2 FIND 0 M ; 

■ 3 

4 ; F ( FIND OCCURANCE OF FOLLOWING TEXT *) 

5 1 TEXT N ; 

6 

7 : B ( BACKUP CURSOR BY TEXT IN PAD *) 

8 PAD C@ MINUS M ; 

9 

10 : X ( DELETE FOLLOWING TEXT *) 

11 1 TEXT FIND PAD C@ DELETE 0 M ; 

12 

13 : TILL ( DELETE ON CURSOR LINE, FROM CURSOR TO TEXT END *) 

14 //LEAD + 1 TEXT ILINE 0- 0 TERROR 

15 #LEAD + SWAP - DELETE 0 M ; —> 


SCR #97 

0 ( STRING EDITOR COMMANDS WFR-79MAR23 ) 

1; C (SPREAD AT CURSOR AND COPY IN THE FOLLOWING TEXT *) 

2 1 TEXT PAD COUNT 

3 //LAG ROT OVER MIN >R 

4 FORTH R R# +! ( BUMP CURSOR ) 

5 R - >R ( CHARS TO SAVE ) 

6 DUP HERE R CMOVE ( FROM OLD CURSOR TO HERE ) 

7 HERE //LEAD + R> CMOVE ( HERE TO CURSOR LOCATION ) 

8 R> CMOVE UPDATE ( PAD TO OLD CURSOR ) 

9 0 M ( LOOK AT NEW LINE ) ; 

10 FORTH DEFINITIONS DECIMAL 

11 LATEST 12 +ORIGIN ! ( TOP NFA ) 

12 HERE 28 +ORIGIN ! ( FENCE ) 

13 HERE 30 +ORIGIN 1 ( DP ) 

14 ' EDITOR 6 + 32 +ORIGIN ! ( VOC-LINK ) 

15 HERE FENCE ! ;S 


SCR #98 
0 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 
11 
12 
1 3 
14 
15 : 

FORTH INTEREST GROUP 


MAY 1, 1979 





